Due to some technical error All Project source code & Project report are now available on www.ignousupport.blogspot.com Download all project for free
PROJECT SOURCE CODE
SPONSORED LINKS
Create Account Module
Public Function ChangeStr(STR As String)
ChangeStr = Replace(STR, "'", "''")
End Function
Public Function FinalKey_Click() As Boolean
On Error GoTo SAM
Dim size As Long
Dim lval As Long
Dim name1, keystr, keystr1, keystr2, keystr3, keystr4, keystr5, keystr6, keystr7 As String
Dim a, b, d, X, e As String
Dim i As Integer
Dim c As Integer
name1 = VBA.String(255, "")
size = Len(name1)
lval = GetUserName(name1, size)
keystr = Left(name1, (size - 1))
'-----------------computer name
name1 = VBA.String(255, " ")
size = Len(name1)
lval = GetComputerName(name1, size)
keystr1 = Left(name1, size)
'---------------serial no
Set drv = fso.GetDrive("c:")
keystr2 = drv.SerialNumber
'------------------volume
keystr3 = drv.VolumeName
'volume-computer-serial-user
keystr4 = keystr3 + keystr1 + keystr2 + keystr
keystr2 = "Cyber" + keystr2 + "Forte"
'-----------------------ascii
a = Len(keystr2)
For i = 1 To a
c = c + 1
b = Mid(keystr2, c, 1)
d = Asc(b) + 120 & " "
keystr5 = keystr5 + d
keystr6 = keystr6 + Chr(d)
Next
Call Connection1
Set RS = New ADODB.Recordset
RS.Open "select Register from secure where key1='" & keystr6 & "'", Conn, adOpenDynamic, adLockOptimistic
If Not RS.EOF Then
If RS.Fields(0) = "YES" Then
RS.Close
'con1.Close
FinalKey_Click = True
Exit Function
ElseIf RS.Fields(0) = "NO" Then
FinalKey_Click = False
Exit Function
End If
Else
FinalKey_Click = False
End If
Exit Function
SAM:
MsgBox "Error in Running Application Must Register", vbCritical
MsgBox err.Description
FinalKey_Click = False
'Call ErrorLog("FINAL_KEY FUNCTION OF MODELE")
End Function
Public Sub Connection1()
On Error GoTo SAM
Conn.Execute ("create table secure(Key1 text primary key ,Register text,Trial number )")
SAM:
End Sub
Public Function InsertToAccount(ADDMode As Boolean, Voucher As VoucherDataType) As String
Dim SQL As String
Dim SetVoucherRst As New ADODB.Recordset
'SetVoucherRst.CursorLocation = adUseClient
'On Error GoTo erhand
Voucher.Vno = IIf(ADDMode = True, GetVoucherCode(Voucher.VType, Voucher.PaymentType), Voucher.Vno)
If Not ADDMode And Voucher.Vno = "" Then
' MsgBox "Please enter a valid Voucher to edit record.", vbCritical, "Missing Value"
Exit Function
End If
'Update ACTRANS Table at Editing Time
SQL = "SELECT * FROM VOUCHER WHERE VTYPE = '" & Voucher.VType & "' AND VNO = '" & Voucher.Vno & "'"
Set SetVoucherRst = New ADODB.Recordset
SetVoucherRst.Open SQL, Conn, adOpenDynamic, adLockOptimistic, adCmdText
Do Until SetVoucherRst.EOF
Call BalancePost(EditPosting, IIf(SetVoucherRst!DrCr = "D", SetVoucherRst!DrAmt, SetVoucherRst!CrAmt), SetVoucherRst!DrCr, SetVoucherRst!AcCode, Conn)
SetVoucherRst.Delete
SetVoucherRst.MoveNext
Loop
'Saving data to voucher table
Set SetVoucherRst = New ADODB.Recordset
SetVoucherRst.Open "VOUCHER", Conn, adOpenKeyset, adLockOptimistic, adCmdTable
SetVoucherRst.AddNew
SetVoucherRst!sno = GetVoucherID
SetVoucherRst!VType = Voucher.VType
SetVoucherRst!Vno = Voucher.Vno
SetVoucherRst!vDate = Voucher.vDate
SetVoucherRst!AcCode = IIf(Voucher.PaymentType = "Cash", "000030", Voucher.AcCode) 'Cash Account
SetVoucherRst!ACContra = Voucher.ACContra
SetVoucherRst!DrAmt = Voucher.DrAmt ' DrAmt=0
SetVoucherRst!CrAmt = Voucher.CrAmt ' Not CrAmt=0
SetVoucherRst!DrCr = IIf(Voucher.CrAmt = 0, "D", "C") ' DrCr=C
SetVoucherRst!NARR = Voucher.Narration1
SetVoucherRst.UpdateBatch
Set SetVoucherRst = New ADODB.Recordset
SetVoucherRst.Open "VOUCHER", Conn, adOpenDynamic, adLockOptimistic, adCmdTable
SetVoucherRst.AddNew
SetVoucherRst!sno = GetVoucherID
SetVoucherRst!VType = Voucher.VType
SetVoucherRst!Vno = Voucher.Vno
SetVoucherRst!vDate = Voucher.vDate
SetVoucherRst!AcCode = Voucher.ACContra
SetVoucherRst!ACContra = IIf(Voucher.PaymentType = "Cash", "000030", Voucher.AcCode)
SetVoucherRst!DrAmt = Voucher.CrAmt
SetVoucherRst!CrAmt = Voucher.DrAmt
SetVoucherRst!DrCr = IIf(Voucher.CrAmt = 0, "C", "D")
SetVoucherRst!NARR = Voucher.Narration2
SetVoucherRst.UpdateBatch
Set SetVoucherRst = Nothing
'Update ACTRANS Table
SQL = "SELECT * FROM VOUCHER WHERE VTYPE = '" & Voucher.VType & "' AND VNO = '" & Voucher.Vno & "'"
If SetVoucherRst.State = adStateOpen Then SetVoucherRst.Close
SetVoucherRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
Do Until SetVoucherRst.EOF
Call BalancePost(ADDPosting, IIf(SetVoucherRst!DrCr = "D", SetVoucherRst!DrAmt, SetVoucherRst!CrAmt), SetVoucherRst!DrCr, SetVoucherRst!AcCode, Conn)
SetVoucherRst.MoveNext
Loop
InsertToAccount = Voucher.Vno
Exit Function
'erhand:
' ErrHandler "Module1.InsertToAccount()"
End Function
Public Function GetVoucherData(Narra As String) As VoucherDataType
Dim SQL As String
Dim GetVoucherRst As New ADODB.Recordset
Dim VD As VoucherDataType
'On Error GoTo erhand
GetVoucherRst.CursorLocation = adUseClient
SQL = "SELECT * FROM VOUCHER WHERE NARR='" & Narra & "'"
If GetVoucherRst.State = adStateOpen Then GetVoucherRst.Close
GetVoucherRst.Open SQL, Conn, adOpenKeyset, adLockOptimistic, adCmdText
If Not GetVoucherRst.EOF Then
VD.VType = GetVoucherRst!VType
VD.Vno = GetVoucherRst!Vno
VD.vDate = GetVoucherRst!vDate
VD.AcCode = GetVoucherRst!AcCode
VD.ACContra = GetVoucherRst!ACContra
VD.DrAmt = GetVoucherRst!DrAmt
VD.CrAmt = GetVoucherRst!CrAmt
VD.DrCr = GetVoucherRst!DrCr
VD.Narration1 = GetVoucherRst!NARR
VD.Narration2 = ""
End If
Set GetVoucherRst = Nothing
GetVoucherData = VD
'erhand:
' ErrHandler "Module1.GetVoucherData()"
End Function
Private Function GetVoucherCode(VType As String, CashType As String) As String
Dim RS As New ADODB.Recordset
Dim SQL As String
SQL = "Select Max(CONVERT(INT,substring(VNO,2,LEN(VNO)-1))) From Voucher WHERE LEFT(VNO,1) = '" & IIf(CashType = "Cash", "C", "R") & "' AND VTYPE = '" & VType & "'"
RS.Open SQL, Conn, adOpenDynamic, adLockOptimistic
GetVoucherCode = IIf(CashType = "Cash", "C", "R") & GetProperCode(IIf(IsNull(RS(0)), "1", RS(0) + 1), 5)
End Function
Private Function GetVoucherID() As String
Dim RS As New ADODB.Recordset
RS.Open "Select Max(SNO) From VOUCHER", Conn, adOpenDynamic, adLockOptimistic
If Not RS.EOF Then GetVoucherID = GetProperCode(IIf(IsNull(RS(0)), "1", RS(0) + 1), 6) Else GetVoucherID = GetProperCode("1", 6)
End Function