0byt3m1n1
Path:
C:
/
BACKUPS
/
Biometric Backup
/
KELTRON
/
COSEC V14R4.1
/
Setup
/
API Samples
/
VB 6.0
/
[
Home
]
File: ctlUserData.ctl
VERSION 5.00 Begin VB.UserControl ctlUserData ClientHeight = 3390 ClientLeft = 0 ClientTop = 0 ClientWidth = 6765 ScaleHeight = 3390 ScaleWidth = 6765 Begin VB.CommandButton cmdGetData Caption = "&Get Data" Height = 375 Left = 2460 TabIndex = 30 Top = 2100 Width = 1215 End Begin VB.Frame FrameSaveTo BorderStyle = 0 'None Height = 315 Left = 60 TabIndex = 27 Top = 2760 Width = 6375 Begin VB.TextBox txtSavePath Height = 315 Left = 780 Locked = -1 'True TabIndex = 29 Top = 0 Width = 5595 End Begin VB.Label Label2 Caption = "Save to:" Height = 255 Left = 60 TabIndex = 28 Top = 60 Width = 675 End End Begin VB.Frame FrameFormat Caption = "Format" Height = 735 Left = 60 TabIndex = 24 Top = 1860 Width = 2175 Begin VB.OptionButton optformatText Caption = "text" Height = 255 Left = 180 TabIndex = 26 Top = 300 Value = -1 'True Width = 675 End Begin VB.OptionButton optformatXml Caption = "xml" Height = 255 Left = 1200 TabIndex = 25 Top = 300 Width = 675 End End Begin VB.Frame FrameRange BorderStyle = 0 'None Height = 735 Left = 60 TabIndex = 18 Top = 1020 Width = 5955 Begin VB.TextBox txtRangeID Height = 315 Left = 600 TabIndex = 21 Top = 420 Width = 3375 End Begin VB.ComboBox cmbRange Height = 315 ItemData = "ctlUserData.ctx":0000 Left = 600 List = "ctlUserData.ctx":001F Style = 2 'Dropdown List TabIndex = 20 Top = 0 Width = 3375 End Begin VB.Label Label1 Caption = "e.g: 1,3,15,255 or 1-15" ForeColor = &H000000C0& Height = 255 Index = 9 Left = 4020 TabIndex = 23 Top = 480 Width = 1695 End Begin VB.Label Label1 Caption = "Count:" Height = 195 Index = 8 Left = 0 TabIndex = 22 Top = 480 Width = 555 End Begin VB.Label Label1 Caption = "Range:" Height = 195 Index = 7 Left = 0 TabIndex = 19 Top = 60 Width = 555 End End Begin VB.Frame FrameMonthYear BorderStyle = 0 'None Height = 315 Left = 7080 TabIndex = 13 Top = 1080 Width = 4695 Begin VB.ComboBox cmbMonth Height = 315 ItemData = "ctlUserData.ctx":0077 Left = 600 List = "ctlUserData.ctx":00A2 Style = 2 'Dropdown List TabIndex = 17 Top = 0 Width = 1695 End Begin VB.TextBox txtYear Height = 315 Left = 2940 TabIndex = 14 Top = 0 Width = 1695 End Begin VB.Label Label1 Caption = "Year:" Height = 195 Index = 6 Left = 2400 TabIndex = 16 Top = 60 Width = 555 End Begin VB.Label Label1 Caption = "Month:" Height = 195 Index = 4 Left = 0 TabIndex = 15 Top = 60 Width = 555 End End Begin VB.Frame frameIndexCount BorderStyle = 0 'None Height = 315 Left = 7080 TabIndex = 8 Top = 600 Width = 4695 Begin VB.TextBox txtIndex Height = 315 Left = 600 TabIndex = 10 Top = 0 Width = 1695 End Begin VB.TextBox txtCount Height = 315 Left = 2940 TabIndex = 9 Top = 0 Width = 1695 End Begin VB.Label Label1 Caption = "Index:" Height = 195 Index = 5 Left = 0 TabIndex = 12 Top = 60 Width = 435 End Begin VB.Label Label1 Caption = "Count:" Height = 195 Index = 3 Left = 2400 TabIndex = 11 Top = 60 Width = 555 End End Begin VB.Frame FrameFromToDate BorderStyle = 0 'None Height = 315 Left = 60 TabIndex = 2 Top = 600 Width = 6915 Begin VB.TextBox txtToDate Height = 315 Left = 2940 TabIndex = 7 Top = 0 Width = 1695 End Begin VB.TextBox txtFromDate Height = 315 Left = 600 TabIndex = 4 Top = 0 Width = 1695 End Begin VB.Label Label1 Caption = "To:" Height = 195 Index = 2 Left = 2580 TabIndex = 6 Top = 60 Width = 315 End Begin VB.Label Label1 Caption = "DDMMYYYY (e.g. 15062011)" ForeColor = &H000000C0& Height = 255 Index = 22 Left = 4740 TabIndex = 5 Top = 60 Width = 2175 End Begin VB.Label Label1 Caption = "From:" Height = 195 Index = 1 Left = 0 TabIndex = 3 Top = 60 Width = 435 End End Begin VB.ComboBox cmbRequestType Height = 315 ItemData = "ctlUserData.ctx":00CD Left = 1440 List = "ctlUserData.ctx":00DD Style = 2 'Dropdown List TabIndex = 1 Top = 120 Width = 4875 End Begin VB.Label Label1 Caption = "Request Type:" Height = 195 Index = 0 Left = 60 TabIndex = 0 Top = 180 Width = 1335 End End Attribute VB_Name = "ctlUserData" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = False Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Function GetAPIDataFolder() As String Dim SaveDir As String SaveDir = App.Path If (Mid(SaveDir, Len(SaveDir)) <> "\") Then SaveDir = SaveDir + "\" End If SaveDir = SaveDir + "ApiData" Dim fsys As New FileSystemObject If (fsys.FolderExists(SaveDir) = False) Then fsys.CreateFolder SaveDir End If GetAPIDataFolder = SaveDir End Function Private Function GetAPIDataFileName() As String Dim filName As String filName = "" Select Case (cmbRequestType.Text) Case "Access Control Events" filName = "acsEvents" Case "Time & Attendance Events": filName = "taEvents" Case "Daily Attendance Data": filName = "dailyAttendanceData" Case "Monthly Attendance Data": filName = "monthlyAttendanceData" End Select If (optformatText.Value = True) Then GetAPIDataFileName = filName + ".txt" Else GetAPIDataFileName = filName + ".xml" End If End Function Private Sub cmbRange_Change() If (cmbRange.ListIndex = 0) Then Label1(8).Visible = False txtRangeID.Visible = False Label1(9).Visible = False Else Label1(8).Visible = True txtRangeID.Visible = True Label1(9).Visible = True End If End Sub Private Sub cmbRequestType_Change() Dim SaveDir As String SaveDir = GetAPIDataFolder() + "\" + GetAPIDataFileName() txtSavePath.Text = SaveDir Select Case (cmbRequestType.Text) Case "Time & Attendance Events" frameIndexCount.Left = 60 frameIndexCount.Top = 600 frameIndexCount.Visible = True FrameFromToDate.Visible = False FrameMonthYear.Visible = False FrameRange.Visible = False Case "Access Control Events" frameIndexCount.Left = 60 frameIndexCount.Top = 600 frameIndexCount.Visible = True FrameFromToDate.Visible = False FrameMonthYear.Visible = False FrameRange.Visible = False Case "Daily Attendance Data" FrameFromToDate.Left = 60 FrameFromToDate.Top = 600 FrameFromToDate.Visible = True FrameRange.Visible = True frameIndexCount.Visible = False FrameMonthYear.Visible = False Case "Monthly Attendance Data" FrameMonthYear.Left = 60 FrameMonthYear.Top = 600 FrameMonthYear.Visible = True FrameRange.Visible = True FrameFromToDate.Visible = False frameIndexCount.Visible = False End Select End Sub Private Sub cmbRequestType_Click() cmbRequestType_Change End Sub Private Sub cmdGetData_Click() On Error GoTo errlbl: If (cmbRequestType.ListIndex < 0) Then MsgBox "Select request type" Exit Sub End If Form1.ShowMessage "Requesting...", True DoEvents Dim responseData As APIResponse Dim requestformat As DataFormat requestformat = Text If (optformatText.Value = True) Then requestformat = Text Else requestformat = xml End If Select Case cmbRequestType.Text Case "Time & Attendance Events" Set responseData = Form1.apiHelperObj.GetEventTA(txtIndex.Text, txtCount.Text, requestformat) Case "Access Control Events" Set responseData = Form1.apiHelperObj.GetEventACS(txtIndex.Text, txtCount.Text, requestformat) Case "Daily Attendance Data" Set responseData = Form1.apiHelperObj.GetAttendanceDaily(txtFromDate.Text, txtToDate.Text, cmbRange.Text, txtRangeID.Text, requestformat) Case "Monthly Attendance Data" Set responseData = Form1.apiHelperObj.GetAttendanceMonthly(cmbMonth.Text, txtYear.Text, cmbRange.Text, txtRangeID.Text, requestformat) End Select If (Not responseData Is Nothing) Then If (Trim(responseData.Data) <> "") Then Dim SaveDir As String SaveDir = GetAPIDataFolder() + "\" + GetAPIDataFileName() Dim fsys As New FileSystemObject Dim txtStr As TextStream Set txtStr = fsys.OpenTextFile(SaveDir, ForWriting, True) txtStr.Write (responseData.Data) txtStr.Close ShellExecute 0, "open", SaveDir, vbNullString, vbNullString, 0 End If If (responseData.IsSuccess) Then If (responseData.SuccessFailMessage = "") Then Form1.ShowMessage "Request completed", True Else Form1.ShowMessage responseData.SuccessFailMessage, True End If Else Form1.ShowMessage responseData.SuccessFailMessage, False End If End If Exit Sub errlbl: MsgBox (err.Description) End Sub Private Sub optformatText_Click() Dim SaveDir As String SaveDir = GetAPIDataFolder() + "\" + GetAPIDataFileName() txtSavePath.Text = SaveDir End Sub Private Sub optformatXml_Click() Dim SaveDir As String SaveDir = GetAPIDataFolder() + "\" + GetAPIDataFileName() txtSavePath.Text = SaveDir End Sub Private Sub UserControl_Initialize() Width = 6765 Height = 3390 End Sub Private Sub UserControl_Resize() Width = 6765 Height = 3390 End Sub