Global variables used by the sample program
This section defines the global variables used by the sample program.
Option Explicit
Global Const defini = "vbarsole.ini" 'Default ini file name
Global Const defstanza = "VBARSOLE" 'Default stanza
' The following constants were obtained from arsoleex.h
Global Const ARS_OLE_USER_MSG_MODE_SHOW = 1
Global Const ARS_OLE_USER_MSG_MODE_SUPPRESS = 2
Global Const ARS_OLE_FIND_FIRST = 1
Global Const ARS_OLE_FIND_PREV = 2
Global Const ARS_OLE_FIND_NEXT = 3
Global Const ARS_OLE_OPR_EQUAL = 1
Global Const ARS_OLE_OPR_NOT_EQUAL = 2
Global Const ARS_OLE_OPR_LESS_THAN = 3
Global Const ARS_OLE_OPR_LESS_THAN_OR_EQUAL = 4
Global Const ARS_OLE_OPR_GREATER_THAN = 5
Global Const ARS_OLE_OPR_GREATER_THAN_OR_EQUAL = 6
Global Const ARS_OLE_OPR_BETWEEN = 7
Global Const ARS_OLE_OPR_NOT_BETWEEN = 8
Global Const ARS_OLE_OPR_IN = 9
Global Const ARS_OLE_OPR_NOT_IN = 10
Global Const ARS_OLE_OPR_LIKE = 11
Global Const ARS_OLE_OPR_NOT_LIKE = 12
Global Const ARS_OLE_RC_SUCCESS = 0
Global Const ARS_OLE_RC_NO_MEMORY = 1
Global Const ARS_OLE_RC_SERVER_ERROR = 2
Global Const ARS_OLE_RC_USER_CANCELLED = 3
Global Const ARS_OLE_RC_INVALID_DIRECTORY = 4
Global Const ARS_OLE_RC_UNAUTHORIZED_OPERATION = 5
Global Const ARS_OLE_RC_NOT_SUPPORTED = 6
Global Const ARS_OLE_RC_FILE_ERROR = 7
Global Const ARS_OLE_RC_ALREADY_LOGGED_ON = 8
Global Const ARS_OLE_RC_NOT_LOGGED_ON = 9
Global Const ARS_OLE_RC_FOLDER_ALREADY_OPEN = 10
Global Const ARS_OLE_RC_FOLDER_NOT_OPEN = 11
Global Const ARS_OLE_RC_UNKNOWN_FOLDER = 12
Global Const ARS_OLE_RC_NO_FOLDERS_AVAILABLE = 13
Global Const ARS_OLE_RC_DOC_NOT_OPEN = 14
Global Const ARS_OLE_RC_DOC_ALREADY_OPEN = 15
Global Const ARS_OLE_RC_NO_DOC_AVAILABLE = 16
Global Const ARS_OLE_RC_OPEN_DOC_FAILED = 17
Global Const ARS_OLE_RC_DOC_CANNOT_HORZ_SCROLL = 18
Global Const ARS_OLE_RC_INVALID_DOC_INDEX = 19
Global Const ARS_OLE_RC_INVALID_CONTROL_ID = 20
Global Const ARS_OLE_RC_INVALID_FIELD = 21
Global Const ARS_OLE_RC_INVALID_OPERATOR = 22
Global Const ARS_OLE_RC_INVALID_MESSAGE_MODE = 23
Global Const ARS_OLE_RC_INVALID_ZOOM_PERCENT = 24
Global Const ARS_OLE_RC_INVALID_PAGE_NUMBER = 25
Global Const ARS_OLE_RC_INVALID_ROTATION = 26
Global Const ARS_OLE_RC_INVALID_COLOR = 27
Global Const ARS_OLE_RC_INVALID_COPIES = 28
Global Const ARS_OLE_RC_INVALID_ORIENTATION = 29
Global Const ARS_OLE_RC_INVALID_PRINTER = 30
Global Const ARS_OLE_RC_INVALID_FIND_TYPE = 31
Global Const ARS_OLE_RC_ERROR_DURING_PRINT = 32
Global Const ARS_OLE_SCROLL_LINEUP = 0
Global Const ARS_OLE_SCROLL_LINELEFT = 0
Global Const ARS_OLE_SCROLL_LINEDOWN = 1
Global Const ARS_OLE_SCROLL_LINERIGHT = 1
Global Const ARS_OLE_SCROLL_PAGEUP = 2
Global Const ARS_OLE_SCROLL_PAGELEFT = 2
Global Const ARS_OLE_SCROLL_PAGEDOWN = 3
Global Const ARS_OLE_SCROLL_PAGERIGHT = 3
Global Const ARS_OLE_SCROLL_THUMBPOSITION = 4
Global Const ARS_OLE_SCROLL_THUMBTRACK = 5
Global Const ARS_OLE_SCROLL_TOP = 6
Global Const ARS_OLE_SCROLL_LEFT = 6
Global Const ARS_OLE_SCROLL_BOTTOM = 7
Global Const ARS_OLE_SCROLL_RIGHT = 7
Global Const ARS_OLE_SCROLL_ENDSCROLL = 8
Global Const DocZoom = 110
Global server As String 'Server name
Global userid As String 'userid
Global password As String 'password
Global folder As String 'folder
Global doc_id As Integer
Global doc_values(0 To 8) As String
Global OpenDoc As Boolean
Global VertScrollOld As Integer
Global HorzScrollOld As Integer
'Define the Windows APIs used by the program
Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA"
(ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long,
ByVal lpFileName As String) As Long
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA"
(ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String,
ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'Declare Function GetPrivateProfileString Lib "kernel32" (ByVal sname$, ByVal Kname$, ByVal Def$,
ByVal ret$, ByVal Size%, ByVal Fname$) As Integer
Public Sub Main()
Dim rc As Integer
Load frmMain
Load frmInit
doc_id = 0
OpenDoc = False
VertScrollOld = 0
HorzScrollOld = 0
'Disable "View" buttons
frmMain.cmdViewStmt1.Enabled = False
frmMain.cmdViewStmt2.Enabled = False
frmMain.cmdViewStmt3.Enabled = False
'Because we need the ocx file and the arssck32.dll
'which reside in the ars directory I will require
'that this exe and its ini file also reside in the
'ars install directory.
'I should check for ini file existance first.
'Try to find the "Server" name in the ini file
server = fncParmGet(defstanza, "Server", defini)
If Len(server) = 0 Then
MsgBox "Cannot find Server in " + defini
End
End If
'Try to find the "Userid" name in the ini file
userid = fncParmGet(defstanza, "Userid", defini)
If Len(userid) = 0 Then
MsgBox "Cannot find Userid in " + defini
End
End If
'Try to find the "Server" name in the ini file
password = fncParmGet(defstanza, "Password", defini)
If Len(password) = 0 Then
password = " "
End If
'Try to find the "Folder" name in the ini file
folder = fncParmGet(defstanza, "Folder", defini)
If Len(folder) = 0 Then
MsgBox "Cannot find Folder in " + defini
End
End If
'The following call is for debug.
rc = frmMain.ArsOle.SetUserMessageMode(ARS_OLE_USER_MSG_MODE_SHOW)
frmInit.Show
frmInit.pnlStatus.Caption = "Logging on to Server..."
'Attempt to logon to the specified server.
rc = frmMain.ArsOle.Logon(server, userid, password)
If rc <> ARS_OLE_RC_SUCCESS Then
frmInit.pnlStatus.Caption = ""
MsgBox "Cannot Logon to server " + server + "; rc = " + Str(rc)
End
End If
frmInit.SetFocus
'Attempt to open the folder specified in the ini file.
frmInit.pnlStatus.Caption = "Opening folder..."
rc = frmMain.ArsOle.OpenFolder(folder)
If rc <> ARS_OLE_RC_SUCCESS Then
frmMain.pnlStatus.Caption = ""
MsgBox "Cannot open folder " + folder + "; rc = " + Str(rc)
frmMain.ArsOle.Logoff
End
End If
frmInit.SetFocus
frmInit.pnlStatus.Caption = ""
frmInit.Hide
frmMain.Show
End Sub
'This function returns information from the ini file.
Function fncParmGet(ByVal stanza As String, ByVal keyname As String, ByVal inifile As String)
Dim Default, result As String
Dim rc As Integer
Default = ""
result = Space$(255)
rc = GetPrivateProfileString(stanza, keyname, Default, result, Len(result), inifile)
If rc Then
fncParmGet = Trim$(result)
If Len(fncParmGet) > 1 Then
fncParmGet = Left$(fncParmGet, Len(fncParmGet) - 1)
End If
Else
fncParmGet = ""
End If
End Function
'This function is only used to dummy up the date paid
'field of the form because for the
'demo, which uses the 'Baxter Bay Credit' folder,
'we cannot get this information from the database.
'This function adds approximately 20 days to the statement
'date field (which is passed in).
Public Function fncParseDate(ByVal stmtdate As String)
Dim date_array(1 To 3) As String
Dim searchch, workline, workchar As String
Dim txtptr, lenstring, i As Integer
Dim pay_day, pay_month, pay_year As Integer
txtptr = 0
searchch = Chr(47)
workline = ""
lenstring = Len(stmtdate)
'Extract chars to the first '/'
For i = 1 To lenstring
workchar = Mid$(stmtdate, i, 1)
'When a '/' is found, store result, reset
If workchar = searchch Then
txtptr = txtptr + 1
date_array(txtptr) = workline
workline = ""
'Otherwise, keep building the work string
Else
workline = workline + workchar
End If
Next
If Len(workline) > 0 Then
txtptr = txtptr + 1
date_array(txtptr) = workline
End If
'date_array contains three elements, the first is the month
'number, the second is the day of the month, and the third is
'the year. Simply check if the day of the month plus 20
'is greater than 28, if so the difference becomes the new
'day of the month, and we increment the month number.
pay_day = Int(date_array(2)) + 20
pay_month = Int(date_array(1))
pay_year = Int(date_array(3))
If pay_day > 28 Then
pay_day = pay_day - 28
pay_month = pay_month + 1
If pay_month > 12 Then
pay_month = 1
pay_year = pay_year + 1
End If
End If
fncParseDate = LTrim(Str(pay_month)) + "/" + LTrim(Str(pay_day)) + "/" + LTrim(Str(pay_year))
End Function
Private Sub cmdCustInfo_Click()
Dim rc As Integer
Dim acct_num, ini_str As String
Dim first_num, second_num, third_num As Integer
Dim temp As String
Dim numdocs As Variant
If OpenDoc Then
pnlStatus.Caption = "Closing document..."
rc = ArsOle.CloseDoc()
pnlStatus.Caption = ""
End If
'Clear the payment record fields
pnlStmtDate1.Caption = ""
pnlStmtDate2.Caption = ""
pnlStmtDate3.Caption = ""
pnlBalance1.Caption = ""
pnlBalance2.Caption = ""
pnlBalance3.Caption = ""
pnlDatePaid1.Caption = ""
pnlDatePaid2.Caption = ""
pnlDatePaid3.Caption = ""
'Clear the customer information fields
pnlNameData = ""
pnlSOSData = ""
pnlDOBData = ""
pnlMNameData = ""
pnlAddrData1 = ""
pnlAddrData2 = ""
pnlPhoneData = ""
'Disable "View" buttons
cmdViewStmt1.Enabled = False
cmdViewStmt2.Enabled = False
cmdViewStmt3.Enabled = False
'Look up the account number, contained in the pnlAcctnumData text field
'in the arsvblan.ini file. If found, read the respective
'fields. If not found display error message.
acct_num = txtAcctnumData.Text
'Do at least a little validation.
If Len(acct_num) <> 11 Then
MsgBox "Correct format for account # is 000-000-000"
Exit Sub
End If
'If we have gotten to here we know that we have an account
'number of the format 000-000-000. If either of the first
'two sections of the number are nonzero or if the third
'section is not between 001-046 then default to the account
'number 000-000-001.
first_num = Int(Mid(acct_num, 1, 3))
second_num = Int(Mid(acct_num, 5, 3))
third_num = Int(Mid(acct_num, 9, 3))
If first_num <> 0 Or second_num <> 0 Or third_num > 46 Then
acct_num = "000-000-001"
ElseIf third_num = 0 Then
MsgBox "Invalid account number!"
Exit Sub
End If
ini_str = fncParmGet(acct_num, "Name", defini)
If Len(ini_str) = 0 Then
MsgBox "'Name' field not found for acct#" + acct_num + "in " + ininame
Exit Sub
End If
pnlNameData.Caption = " " + ini_str
ini_str = fncParmGet(acct_num, "SSN", defini)
If Len(ini_str) = 0 Then
MsgBox "'SSN' field not found for acct#" + acct_num + "in " + ininame
Exit Sub
End If
pnlSSNData.Caption = " " + ini_str
ini_str = fncParmGet(acct_num, "DOB", defini)
If Len(ini_str) = 0 Then
MsgBox "'DOB' field not found for acct#" + acct_num + "in " + ininame
Exit Sub
End If
pnlDOBData.Caption = " " + ini_str
ini_str = fncParmGet(acct_num, "MaidenName", defini)
If Len(ini_str) = 0 Then
MsgBox "'MaidenName' field not found for acct#" + acct_num + "in " + ininame
Exit Sub
End If
pnlMNameData.Caption = " " + ini_str
ini_str = fncParmGet(acct_num, "StreetAddress", defini)
If Len(ini_str) = 0 Then
MsgBox "'StreetAddress' field not found for acct#" + acct_num + "in " + ininame
Exit Sub
End If
pnlAddrData1.Caption = " " + ini_str
ini_str = fncParmGet(acct_num, "CityStateZip", defini)
If Len(ini_str) = 0 Then
MsgBox "'CityStateZip' field not found for acct#" + acct_num + "in " + ininame
Exit Sub
End If
pnlAddrData2.Caption = " " + ini_str
ini_str = fncParmGet(acct_num, "PhoneNum", defini)
If Len(ini_str) = 0 Then
MsgBox "'PhoneNum' field not found for acct#" + acct_num + "in " + ininame
Exit Sub
End If
pnlPhoneData.Caption = " " + ini_str
'We are changing customer accounts so before we get new customer
'information, close old customers open documents.
If doc_id <> 0 Then
rc = ArsOle.CloseDoc
If rc <> ARS_OLE_RC_SUCCESS Then
pnlStatus.Caption = ""
MsgBox "Cannot set folder search criteria; rc = " + Str(rc)
ArsOle.CloseFolder
ArsOle.Logoff
End
End If
End If
pnlStatus.Caption = "Searching folder..."
rc = ArsOle.SetFolderSearchFieldData("Account", ARS_OLE_OPR_EQUAL, acct_num, "")
If rc <> ARS_OLE_RC_SUCCESS Then
pnlStatus.Caption = ""
MsgBox "Cannot set folder search criteria; rc = " + Str(rc)
ArsOle.CloseFolder
ArsOle.Logoff
End
End If
rc = ArsOle.SearchFolder(0)
If rc <> ARS_OLE_RC_SUCCESS Then
pnlStatus.Caption = ""
MsgBox "Search folder failed; rc = " + Str(rc)
ArsOle.CloseFolder
ArsOle.Logoff
End
End If
rc = ArsOle.GetNumDocsInList(numdocs)
rc = ArsOle.GetDocDisplayValue(numdocs - 1, 0, temp)
pnlStmtDate1.Caption = temp
pnlDatePaid1.Caption = fncParseDate(temp)
rc = ArsOle.GetDocDisplayValue(numdocs - 2, 0, temp)
pnlStmtDate2.Caption = temp
pnlDatePaid2.Caption = fncParseDate(temp)
rc = ArsOle.GetDocDisplayValue(numdocs - 3, 0, temp)
pnlStmtDate3.Caption = temp
pnlDatePaid3.Caption = fncParseDate(temp)
rc = ArsOle.GetDocDisplayValue(numdocs - 1, 3, temp)
pnlBalance1.Caption = temp
rc = ArsOle.GetDocDisplayValue(numdocs - 2, 3, temp)
pnlBalance2.Caption = temp
rc = ArsOle.GetDocDisplayValue(numdocs - 3, 3, temp)
pnlBalance3.Caption = temp
'Enable "View" buttons
cmdViewStmt1.Enabled = True
cmdViewStmt2.Enabled = True
cmdViewStmt3.Enabled = True
pnlStatus.Caption = ""
End Sub
Private Sub cmdExit_Click()
'If OpenDoc Then
' ArsOle.CloseDoc
'End If
'ArsOle.CloseFolder
'ArsOle.Logoff
End
End Sub
Private Sub cmdViewStmt1_Click()
Dim numdocs As Variant
rc = ArsOle.GetNumDocsInList(numdocs)
If OpenDoc Then
pnlStatus.Caption = "Closing document..."
rc = ArsOle.CloseDoc()
pnlStatus.Caption = ""
vscrollDoc.Value = 0
hscrollDoc.Value = 0
End If
pnlStatus.Caption = "Retrieving document..."
rc = ArsOle.OpenDoc(numdocs - 1, "", 0)
If rc <> ARS_OLE_RC_SUCCESS Then
pnlStatus.Caption = ""
MsgBox "Open document failed; rc = " + Str(rc)
ArsOle.CloseFolder
ArsOle.Logoff
End
End If
pnlStatus.Caption = ""
OpenDoc = True
rc = ArsOle.SetDocZoom(DocZoom, horzPos, vertPos)
vscrollDoc.Value = vertPos
hscrollDoc.Value = horzPos
End Sub
Private Sub cmdViewStmt2_Click()
Dim numdocs As Variant
rc = ArsOle.GetNumDocsInList(numdocs)
If OpenDoc Then
pnlStatus.Caption = "Closing document..."
rc = ArsOle.CloseDoc()
pnlStatus.Caption = ""
vscrollDoc.Value = 0
hscrollDoc.Value = 0
End If
pnlStatus.Caption = "Retrieving document..."
rc = ArsOle.OpenDoc(numdocs - 2, "", 0)
If rc <> ARS_OLE_RC_SUCCESS Then
pnlStatus.Caption = ""
MsgBox "Open document failed; rc = " + Str(rc)
ArsOle.CloseFolder
ArsOle.Logoff
End
End If
pnlStatus.Caption = ""
OpenDoc = True
rc = ArsOle.SetDocZoom(DocZoom, horzPos, vertPos)
End Sub
Private Sub cmdViewStmt3_Click()
Dim numdocs As Variant
rc = ArsOle.GetNumDocsInList(numdocs)
If OpenDoc Then
pnlStatus.Caption = "Closing document..."
rc = ArsOle.CloseDoc()
pnlStatus.Caption = ""
vscrollDoc.Value = 0
hscrollDoc.Value = 0
End If
pnlStatus.Caption = "Retrieving document..."
rc = ArsOle.OpenDoc(numdocs - 3, "", 0)
If rc <> ARS_OLE_RC_SUCCESS Then
pnlStatus.Caption = ""
MsgBox "Open document failed; rc = " + Str(rc)
ArsOle.CloseFolder
ArsOle.Logoff
End
End If
pnlStatus.Caption = ""
OpenDoc = True
rc = ArsOle.SetDocZoom(DocZoom, horzPos, vertPos)
End Sub
Private Sub Form_Unload(Cancel As Integer)
If OpenDoc Then
ArsOle.CloseDoc
End If
ArsOle.CloseFolder
ArsOle.Logoff
End
End Sub
Private Sub hscrollDoc_Change()
Dim Diff As Integer
Dim rc As Integer
Dim ScrollCode As Integer
Dim NewPos As Variant
NewPos = 0
Diff = hscrollDoc.Value - HorzScrollOld
If Diff = hscrollDoc.LargeChange Then
ScrollCode = ARS_OLE_SCROLL_PAGERIGHT
rc = ArsOle.ScrollDocHorz(ScrollCode, NewPos)
hscrollDoc.Value = NewPos
ElseIf Diff = -hscrollDoc.LargeChange Then
ScrollCode = ARS_OLE_SCROLL_PAGELEFT
rc = ArsOle.ScrollDocHorz(ScrollCode, NewPos)
hscrollDoc.Value = NewPos
ElseIf Diff = hscrollDoc.SmallChange Then
ScrollCode = ARS_OLE_SCROLL_LINERIGHT
rc = ArsOle.ScrollDocHorz(ScrollCode, NewPos)
hscrollDoc.Value = NewPos
ElseIf Diff = -hscrollDoc.SmallChange Then
ScrollCode = ARS_OLE_SCROLL_LINELEFT
rc = ArsOle.ScrollDocHorz(ScrollCode, NewPos)
hscrollDoc.Value = NewPos
Else
ScrollCode = ARS_OLE_SCROLL_THUMBPOSITION
NewPos = hscrollDoc.Value
rc = ArsOle.ScrollDocHorz(ScrollCode, NewPos)
HorzScrollOld = hscrollDoc.Value
End If
HorzScrollOld = hscrollDoc.Value
End Sub
Private Sub vscrollDoc_Change()
Dim Diff As Integer
Dim rc As Integer
Dim ScrollCode As Integer
Dim NewPos As Variant
NewPos = 0
Diff = vscrollDoc.Value - VertScrollOld
If Diff = vscrollDoc.LargeChange Then
ScrollCode = ARS_OLE_SCROLL_PAGEDOWN
rc = ArsOle.ScrollDocVert(ScrollCode, NewPos)
VertScrollOld = NewPos
vscrollDoc.Value = NewPos
ElseIf Diff = -vscrollDoc.LargeChange Then
ScrollCode = ARS_OLE_SCROLL_PAGEUP
rc = ArsOle.ScrollDocVert(ScrollCode, NewPos)
VertScrollOld = NewPos
vscrollDoc.Value = NewPos
ElseIf Diff = vscrollDoc.SmallChange Then
ScrollCode = ARS_OLE_SCROLL_LINEDOWN
rc = ArsOle.ScrollDocVert(ScrollCode, NewPos)
VertScrollOld = NewPos
vscrollDoc.Value = NewPos
ElseIf Diff = -vscrollDoc.SmallChange Then
ScrollCode = ARS_OLE_SCROLL_LINEUP
rc = ArsOle.ScrollDocVert(ScrollCode, NewPos)
VertScrollOld = NewPos
vscrollDoc.Value = NewPos
Else
ScrollCode = ARS_OLE_SCROLL_THUMBPOSITION
NewPos = vscrollDoc.Value
rc = ArsOle.ScrollDocVert(ScrollCode, NewPos)
VertScrollOld = vscrollDoc.Value
End If
End Sub