Option Explicit
Public Event Click()
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Private Sub UserControl_Initialize()
UserControl.BackColor = vbWhite
UserControl.BackStyle = 0
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Set Picture = PropBag.ReadProperty("Picture", Nothing)
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
PropBag.WriteProperty "Picture", Picture, Nothing
End Sub
Public Sub requestRefresh()
UserControl.Picture = UserControl.Image
UserControl.Refresh
End Sub
Public Property Let ScaleWidth(newSW As Single)
On Error Resume Next
Redraw
End Property
Public Property Get ScaleWidth() As Single
ScaleWidth = UserControl.ScaleWidth
End Property
Public Property Let ScaleHeight(newSH As Single)
On Error Resume Next
Redraw
End Property
Public Property Get ScaleHeight() As Single
ScaleHeight = UserControl.ScaleHeight
End Property
'====================================================
' Picture and Image control
'====================================================
Public Property Let Picture(newPic As StdPicture)
' this calls the Set Picture() method below, no code needed here.
End Property
Public Property Set Picture(ByVal newPic As StdPicture)
On Error Resume Next
Set UserControl.Picture = newPic
Redraw
PropertyChanged "Picture"
End Property
Public Property Get Picture() As StdPicture
Set Picture = UserControl.Picture
End Property
Private Sub UserControl_Paint()
Redraw
End Sub
Public Sub Redraw()
UserControl.MaskColor = UserControl.BackColor
Set UserControl.MaskPicture = UserControl.Image
UserControl.Refresh
End Sub
Public Property Let Cls(Clear As Boolean)
UserControl.Cls
End Property
Public Property Get AutoRedraw() As Boolean
AutoRedraw = UserControl.AutoRedraw
End Property
Public Property Let AutoRedraw(ByVal New_AutoRedraw As Boolean)
UserControl.AutoRedraw() = New_AutoRedraw
PropertyChanged "AutoRedraw"
End Property
Public Property Get BackColor() As Long
BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal NewValue As Long)
UserControl.BackColor = NewValue
End Property
Private Sub UserControl_Click()
RaiseEvent Click
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
End SubVERSION 5.00
Begin VB.Form frmMain
Caption = "VAGtachoCD715B710A"
ScaleMode = 1
AutoRedraw = False
FontTransparent = True
'Icon = n/a
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ClientLeft = 4095
ClientTop = 3525
ClientWidth = 4110
ClientHeight = 720
Begin CommandButton CMdwritebytes
Caption = "&Write"
Left = 2760
Top = 120
Width = 1215
Height = 495
TabIndex = 1
End
Begin ListBox LoggerList
Left = 120
Top = 120
Width = 2415
Height = 450
Enabled = 0 'False
TabIndex = 0
End
End
Attribute VB_Name = "frmMain"
'VA: 402A04
Private Declare Sub FT_EraseEE Lib "FTD2XX.DLL"()
'VA: 4029C0
Private Declare Sub FT_WriteEE Lib "FTD2XX.DLL"()
'VA: 40297C
Private Declare Sub FT_ReadEE Lib "FTD2XX.DLL"()
'VA: 402938
Private Declare Sub FT_EE_UARead Lib "FTD2XX.DLL"()
'VA: 4028F0
Private Declare Sub FT_EE_UAWrite Lib "FTD2XX.DLL"()
'VA: 4028A8
Private Declare Sub FT_EE_UASize Lib "FTD2XX.DLL"()
'VA: 402860
Private Declare Sub FT_EE_Read Lib "FTD2XX.DLL"()
'VA: 40281C
Private Declare Sub FT_EE_Program Lib "FTD2XX.DLL"()
'VA: 4027D4
Private Declare Sub agGetAddressForObject Lib "apigid32.dll"()
'VA: 402770
Private Declare Function CloseHandle Lib "kernel32" Alias "CloseHandle" (ByVal hObject As Long) As Long
'VA: 40272C
Private Declare Function TerminateThread Lib "kernel32" Alias "TerminateThread" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
'VA: 4026E4
Private Declare Function CreateThread Lib "kernel32" Alias "CreateThread" (lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
'VA: 40269C
Private Declare Function SetEvent Lib "kernel32" Alias "SetEvent" (ByVal hEvent As Long) As Long
'VA: 402658
Private Declare Function WaitForSingleObject Lib "kernel32" Alias "WaitForSingleObject" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
'VA: 40260C
Private Declare Function CreateEvent Lib "kernel32" Alias "CreateEventA" (lpEventAttributes As SECURITY_ATTRIBUTES, ByVal bManualReset As Long, ByVal bInitialState As Long, ByVal lpName As String) As Long
'VA: 4025C4
Private Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
'VA: 402574
Private Declare Sub FT_W32_SetCommState Lib "FTD2XX.DLL"()
'VA: 402524
Private Declare Sub FT_W32_GetCommState Lib "FTD2XX.DLL"()
'VA: 4024D8
Private Declare Sub FT_W32_GetOverlappedResult Lib "FTD2XX.DLL"()
'VA: 402484
Private Declare Sub FT_W32_WriteFile Lib "FTD2XX.DLL"()
'VA: 402438
Private Declare Sub FT_W32_ReadFile Lib "FTD2XX.DLL"()
'VA: 4023F0
Private Declare Sub FT_W32_CloseHandle Lib "FTD2XX.DLL"()
'VA: 4023A4
Private Declare Sub FT_W32_CreateFile Lib "FTD2XX.DLL"()
'VA: 402358
Private Declare Sub FTID_GetErrorCodeString Lib "FTChipID.DLL"()
'VA: 402308
Private Declare Sub FTID_GetDllVersion Lib "FTChipID.DLL"()
'VA: 4022BC
Private Declare Sub FTID_GetDeviceChipID Lib "FTChipID.DLL"()
'VA: 40226C
Private Declare Sub FTID_GetDeviceLocationID Lib "FTChipID.DLL"()
'VA: 402218
Private Declare Sub FTID_GetDeviceDescription Lib "FTChipID.DLL"()
'VA: 4021C4
Private Declare Sub FTID_GetDeviceSerialNumber Lib "FTChipID.DLL"()
'VA: 402190
Private Declare Sub FTID_GetNumDevices Lib "FTChipID.DLL"()
'VA: 402130
Private Declare Sub FT_Close Lib "FTD2XX.DLL"()
'VA: 4020EC
Private Declare Sub FT_Open Lib "FTD2XX.DLL"()
'VA: 4020AC
Private Declare Sub FT_ListDevices Lib "FTD2XX.DLL"()
Private Sub Form_Load() '404650
loc_00404650: push ebp
loc_00404651: mov ebp, esp
loc_00404653: sub esp, 0000000Ch
loc_00404656: push 00401236h ; undef 'Ignore this
loc_0040465B: mov eax, fs:[00h]
loc_00404661: push eax
loc_00404662: mov fs:[00000000h], esp
loc_00404669: sub esp, 00000034h
loc_0040466C: push ebx
loc_0040466D: push esi
loc_0040466E: push edi
loc_0040466F: mov var_C, esp
loc_00404672: mov var_8, 00401160h
loc_00404679: mov esi, Me
loc_0040467C: mov eax, esi
loc_0040467E: and eax, 00000001h
loc_00404681: mov var_4, eax
loc_00404684: and esi, FFFFFFFEh
loc_00404687: push esi
loc_00404688: mov Me, esi
loc_0040468B: mov ecx, [esi]
loc_0040468D: call [ecx+04h]
loc_00404690: xor eax, eax
loc_00404692: lea edx, var_38
loc_00404695: mov var_38, eax
loc_00404698: lea ecx, var_24
loc_0040469B: mov var_24, eax
loc_0040469E: mov var_28, eax
loc_004046A1: mov var_30, eax
loc_004046A4: mov var_38, 00000002h
loc_004046AB: call [00401010h] ; %ecx = %S_edx_S '__vbaVarMove
loc_004046B1: mov edx, [esi]
loc_004046B3: push esi
loc_004046B4: call [edx+00000300h]
loc_004046BA: push eax
loc_004046BB: lea eax, var_28
loc_004046BE: push eax
loc_004046BF: call [0040103Ch] ; Set %StkVar1 = %StkVar2 'Ignore this
loc_004046C5: sub esp, 00000010h
loc_004046C8: mov ecx, 0000000Ah
loc_004046CD: mov ebx, esp
loc_004046CF: mov var_38, ecx
loc_004046D2: mov edi, eax
loc_004046D4: mov eax, 80020004h
loc_004046D9: mov [ebx], ecx
loc_004046DB: mov ecx, var_34
loc_004046DE: mov var_30, eax
loc_004046E1: mov edx, [edi]
loc_004046E3: mov [ebx+04h], ecx
loc_004046E6: push 00402C6Ch ; "VAG-Tacho-2.XX "
loc_004046EB: push edi
loc_004046EC: mov [ebx+08h], eax
loc_004046EF: mov eax, var_2C
loc_004046F2: mov [ebx+0Ch], eax
loc_004046F5: call [edx+000001ECh]
loc_004046FB: test eax, eax
loc_004046FD: fclex
loc_004046FF: jnl 404713h
loc_00404701: push 000001ECh
loc_00404706: push 00402A48h
loc_0040470B: push edi
loc_0040470C: push eax
loc_0040470D: call [00401034h] ; %StkVar1 = CheckObj(%StkVar2, %StkVar3, %StkVar4)
loc_00404713: mov edi, [004010E0h] ; %ecx = ""
loc_00404719: lea ecx, var_28
loc_0040471C: call edi
loc_0040471E: mov ecx, [esi]
loc_00404720: push esi
loc_00404721: call [ecx+00000300h]
loc_00404727: lea edx, var_28
loc_0040472A: push eax
loc_0040472B: push edx
loc_0040472C: call [0040103Ch] ; Set %StkVar1 = %StkVar2 'Ignore this
loc_00404732: sub esp, 00000010h
loc_00404735: mov ecx, 0000000Ah
loc_0040473A: mov ebx, esp
loc_0040473C: mov var_38, ecx
loc_0040473F: mov esi, eax
loc_00404741: mov eax, 80020004h
loc_00404746: mov [ebx], ecx
loc_00404748: mov ecx, var_34
loc_0040474B: mov var_30, eax
loc_0040474E: mov edx, [esi]
loc_00404750: mov [ebx+04h], ecx
loc_00404753: push 00402C90h ; "Diagnostika_plus@mail.ru "
loc_00404758: push esi
loc_00404759: mov [ebx+08h], eax
loc_0040475C: mov eax, var_2C
loc_0040475F: mov [ebx+0Ch], eax
loc_00404762: call [edx+000001ECh]
loc_00404768: test eax, eax
loc_0040476A: fclex
loc_0040476C: jnl 404780h
loc_0040476E: push 000001ECh
loc_00404773: push 00402A48h
loc_00404778: push esi
loc_00404779: push eax
loc_0040477A: call [00401034h] ; %StkVar1 = CheckObj(%StkVar2, %StkVar3, %StkVar4)
loc_00404780: lea ecx, var_28
loc_00404783: call edi
loc_00404785: mov var_4, 00000000h
loc_0040478C: push 004047A7h
loc_00404791: jmp 40479Dh
loc_00404793: lea ecx, var_28
loc_00404796: call [004010E0h] ; %ecx = ""
loc_0040479C: ret
loc_0040479D: lea ecx, var_24
loc_004047A0: call [00401014h] ; undef 'Ignore this '__vbaFreeVar
loc_004047A6: ret
loc_004047A7: mov eax, Me
loc_004047AA: push eax
loc_004047AB: mov ecx, [eax]
loc_004047AD: call [ecx+08h]
loc_004047B0: mov eax, var_4
loc_004047B3: mov ecx, var_14
loc_004047B6: pop edi
loc_004047B7: pop esi
loc_004047B8: mov fs:[00000000h], ecx
loc_004047BF: pop ebx
loc_004047C0: mov esp, ebp
loc_004047C2: pop ebp
loc_004047C3: retn 0004h
End Sub
Option Compare Database
Option Explicit
Private Sub cmdReport_Click()
DoCmd.OpenForm "Search_Quality", acNormal, , GetFilterFromListBoxes
DoCmd.OpenForm "Graph", acFormPivotChart, , GetFilterFromListBoxes
DoCmd.close acForm, "Search_Quality_Programs", acSavePrompt
End Sub
Private Sub cmdReset_Click()
Dim ctrl As Access.Control
Dim itm As Variant
For Each ctrl In Me.Controls
If ctrl.ControlType = acListBox Then
If ctrl.MultiSelect = 0 Then
ctrl = Null
Else
For Each itm In ctrl.ItemsSelected
ctrl.Selected(itm) = False
Next
End If
End If
Next ctrl
Me.Filter = ""
Me.FilterOn = False
End Sub
Private Sub cmdResults_Click()
Dim formfilter As String
formfilter = GetFilterFromListBoxes
Debug.Print formfilter
Me.FilterOn = False
Me.Filter = formfilter
Me.FilterOn = True
End Sub
Public Function GetFilterFromListBoxes() As String
Dim lst As Access.ListBox
Dim ctrl As Access.Control
Dim fieldName As String
Dim fieldType As String
Dim TotalFilter As String
Dim ListFilter As String
Dim itm As Variant
'Each listbox needs a tag property with the field name and the field type
'Seperate these with a ;
'The types are Text, Numeric, or Date
For Each ctrl In Me.Controls
If ctrl.ControlType = acListBox Then
fieldName = Split(ctrl.tag, ";")(0)
fieldType = Split(ctrl.tag, ";")(1)
For Each itm In ctrl.ItemsSelected
If ListFilter = "" Then
ListFilter = GetProperType(ctrl.ItemData(itm), fieldType)
Else
ListFilter = ListFilter & "," & GetProperType(ctrl.ItemData(itm), fieldType)
End If
Next itm
If Not ListFilter = "" Then
ListFilter = fieldName & " IN (" & ListFilter & ")"
End If
If TotalFilter = "" And ListFilter <> "" Then
TotalFilter = ListFilter
ElseIf TotalFilter <> "" And ListFilter <> "" Then
TotalFilter = TotalFilter & " AND " & ListFilter
End If
ListFilter = ""
End If
Next ctrl
GetFilterFromListBoxes = TotalFilter
End Function
Public Function GetProperType(varItem As Variant, fieldType As String) As Variant
If fieldType = "Text" Then
GetProperType = sqlTxt(varItem)
ElseIf fieldType = "Date" Then
GetProperType = SQLDate(varItem)
Else
GetProperType = varItem
End If
End Function
Public Function sqlTxt(varItem As Variant) As Variant
If Not IsNull(varItem) Then
varItem = Replace(varItem, "'", "''")
sqlTxt = "'" & varItem & "'"
End If
End Function
Function SQLDate(varDate As Variant) As Variant
If IsDate(varDate) Then
If DateValue(varDate) = varDate Then
SQLDate = Format$(varDate, "\#mm\/dd\/yyyy\#")
Else
SQLDate = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
End If
End If
End Function