Next Chapter 66 Create Account Module

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