source: DRBLLiveHelper/CommonModule.bas @ 55

Last change on this file since 55 was 13, checked in by sunny, 17 years ago
File size: 13.7 KB
Line 
1Attribute VB_Name = "CommonModule"
2Option Explicit
3'''''Global Variable''''
4Public Const G_LibPath = "lib\"
5Dim G_DriveID
6'''''
7Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextW" (ByVal hwnd As Long, ByVal lpString As String) As Long
8
9
10Public 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
11Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
12
13Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
14    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
15   
16Public Declare Function GetTempPath Lib "kernel32.dll" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
17   
18Public Declare Function OpenProcess _
19    Lib "kernel32" ( _
20    ByVal dwDesiredAccess As Long, _
21    ByVal bInheritHandle As Long, _
22    ByVal dwProcessID As Long) _
23    As Long
24Public Declare Function WaitForSingleObject _
25    Lib "kernel32" ( _
26    ByVal hHandle As Long, _
27    ByVal dwMilliseconds As Long) _
28    As Long
29Public Declare Function CloseHandle _
30    Lib "kernel32" ( _
31    ByVal hObject As Long) _
32    As Long
33Public Const SYNCHRONIZE = &H100000
34Public Const INFINITE = &HFFFF
35   Public Type STARTUPINFO
36      cb As Long
37      lpReserved As String
38      lpDesktop As String
39      lpTitle As String
40      dwX As Long
41      dwY As Long
42      dwXSize As Long
43      dwYSize As Long
44      dwXCountChars As Long
45      dwYCountChars As Long
46      dwFillAttribute As Long
47      dwFlags As Long
48      wShowWindow As Integer
49      cbReserved2 As Integer
50      lpReserved2 As Long
51      hStdInput As Long
52      hStdOutput As Long
53      hStdError As Long
54   End Type
55
56   Public Type PROCESS_INFORMATION
57      hProcess As Long
58      hThread As Long
59      dwProcessID As Long
60      dwThreadID As Long
61   End Type
62
63  ' Public Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
64  '    hHandle As Long, ByVal dwMilliseconds As Long) As Long
65
66   Public Declare Function CreateProcessA Lib "kernel32" (ByVal _
67      lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
68      lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
69      ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
70      ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
71      lpStartupInfo As STARTUPINFO, lpProcessInformation As _
72      PROCESS_INFORMATION) As Long
73
74  ' Public Declare Function CloseHandle Lib "kernel32" _
75  '    (ByVal hObject As Long) As Long
76
77   Public Declare Function GetExitCodeProcess Lib "kernel32" _
78      (ByVal hProcess As Long, lpExitCode As Long) As Long
79
80   Public Const NORMAL_PRIORITY_CLASS = &H20&
81  ' Public Const INFINITE = -1&
82Public Type OPENFILENAME
83    lStructSize As Long
84    hwndOwner As Long
85    hInstance As Long
86    lpstrFilter As String
87    lpstrCustomFilter As String
88    nMaxCustFilter As Long
89    iFilterIndex As Long
90    lpstrFile As String
91    nMaxFile As Long
92    lpstrFileTitle As String
93    nMaxFileTitle As Long
94    lpstrInitialDir As String
95    lpstrTitle As String
96    flags As Long
97    nFileOffset As Integer
98    nFileExtension As Integer
99    lpstrDefExt As String
100    lCustData As Long
101    lpfnHook As Long
102    lpTemplateName As String
103End Type
104
105Public Enum OFNFlagsEnum
106    OFN_ALLOWMULTISELECT = &H200
107    OFN_CREATEPROMPT = &H2000
108    OFN_ENABLEHOOK = &H20
109    OFN_ENABLETEMPLATE = &H40
110    OFN_ENABLETEMPLATEHANDLE = &H80
111    OFN_EXPLORER = &H80000
112    OFN_EXTENSIONDIFFERENT = &H400
113    OFN_FILEMUSTEXIST = &H1000
114    OFN_HIDEREADONLY = &H4
115    OFN_LONGNAMES = &H200000
116    OFN_NOCHANGEDIR = &H8
117    OFN_NODEREFERENCELINKS = &H100000
118    OFN_NOLONGNAMES = &H40000
119    OFN_NONETWORKBUTTON = &H20000
120    OFN_NOREADONLYRETURN = &H8000
121    OFN_NOTESTFILECREATE = &H10000
122    OFN_NOVALIDATE = &H100
123    OFN_OVERWRITEPROMPT = &H2
124    OFN_PATHMUSTEXIST = &H800
125    OFN_READONLY = &H1
126    OFN_SHAREAWARE = &H4000
127    OFN_SHAREFALLTHROUGH = 2
128    OFN_SHARENOWARN = 1
129    OFN_SHAREWARN = 0
130    OFN_SHOWHELP = &H10
131End Enum
132 
133   
134Public Function ShellAndWait(CommandLine As String)
135    Dim ShellId As Long
136    Dim ShellHandle As Long
137    Dim ret As Long
138    ShellId = Shell(CommandLine, vbHide) 'vbNormalFocus
139    ShellHandle = OpenProcess(SYNCHRONIZE, 0, ShellId)
140    If ShellHandle <> 0 Then
141        ret& = WaitForSingleObject(ShellHandle, INFINITE)
142        CloseHandle ShellHandle
143        ShellAndWait = ret&
144    End If
145End Function
146
147Public Function ExecCmd(cmdline$)
148      Dim proc As PROCESS_INFORMATION
149      Dim start As STARTUPINFO
150      Dim ret As Long
151      ' Initialize the STARTUPINFO structure:
152      start.cb = Len(start)
153
154      ' Start the shelled application:
155      ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
156         NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)
157
158      ' Wait for the shelled application to finish:
159         ret& = WaitForSingleObject(proc.hProcess, INFINITE)
160         Call GetExitCodeProcess(proc.hProcess, ret&)
161         Call CloseHandle(proc.hThread)
162         Call CloseHandle(proc.hProcess)
163         ExecCmd = ret&
164End Function
165
166Public Sub AlwaysOnTop(FrmID As Form, OnTop As Integer)
167    ' ===========================================
168    ' Requires the following declaration
169    ' For VB3:
170    ' Declare Function SetWindowPos Lib "user" (ByVal h%, ByVal hb%, ByVal x%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer
171    ' For VB4:
172    ' Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
173    ' ===========================================
174    ' Usage:
175    ' AlwaysOnTop Me, -1  ' To make always on top
176    ' AlwaysOnTop Me, -2  ' To make NOT always on top
177    ' ===========================================
178    Const SWP_NOMOVE = 2
179    Const SWP_NOSIZE = 1
180    Const flags = SWP_NOMOVE Or SWP_NOSIZE
181    Const HWND_TOPMOST = -1
182    Const HWND_NOTOPMOST = -2
183    If OnTop = -1 Then
184        OnTop = SetWindowPos(FrmID.hwnd, HWND_TOPMOST, 0, 0, 0, 0, flags)
185    Else
186        OnTop = SetWindowPos(FrmID.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, flags)
187    End If
188End Sub
189
190' Show the common dialog to select a file to open. Returns the path of the
191' selected file or a null string if the dialog is canceled
192' Parameters:
193'  - sFilter is used to specify what type(s) of files will be shown
194'  - sDefExt is the default extension associated to a file name if no one is
195' specified by the user
196'  - sInitDir is the directory that will be open when the dialog is shown
197'  - lFlag is a combination of Flags for the dialog. Look at the Common
198' Dialogs' Help for more informations
199'  - hParent is the handle of the parent form
200
201' Example:
202'    Dim sFilter As String
203'    'set the filter: show text files and all the files
204'    sFilter = "Text files (*.txt)|*.txt|All files (*.*)|*.*"
205'    'let the user select a file, ensuring that it exists
206'    MsgBox "File selected: " & ShowOpenFileDialog(sFilter, "txt",
207'  "C:\Documents", OFN_FILEMUSTEXIST)
208
209Function ShowOpenFileDialog(ByVal sFilter As String, Optional ByVal sDefExt As _
210    String, Optional ByVal sInitDir As String, Optional ByVal lFlags As Long, _
211    Optional ByVal hParent As Long) As String
212    Dim OFN As OPENFILENAME
213    On Error Resume Next
214   
215    ' set the values for the OpenFileName struct
216    With OFN
217        .lStructSize = Len(OFN)
218        .hwndOwner = hParent
219        .lpstrFilter = Replace(sFilter, "|", vbNullChar) & vbNullChar
220        .lpstrFile = Space$(255) & vbNullChar & vbNullChar
221        .nMaxFile = Len(.lpstrFile)
222        .flags = lFlags
223        .lpstrInitialDir = sInitDir
224        .lpstrDefExt = sDefExt
225    End With
226   
227    ' show the dialog, non-zero means success
228    If GetOpenFileName(OFN) Then
229        ' extract the selected file (including the path)
230        ShowOpenFileDialog = Left$(OFN.lpstrFile, InStr(OFN.lpstrFile, _
231            vbNullChar) - 1)
232    End If
233End Function
234
235' Return True if a file exists
236Function FileExists(ByVal FileName As String) As Boolean
237    On Error GoTo ErrorHandler
238    ' get the attributes and ensure that it isn't a directory
239    FileExists = (GetAttr(FileName) And vbDirectory) = 0
240ErrorHandler:
241    ' if an error occurs, this function returns False
242End Function
243
244Public Function GetTempDir() As String
245' Returns the temp directory from the OS system
246    Dim sBuffer As String
247    Dim HoldBuffer As String
248    Dim iBuffLen As Long
249    Dim iReturn As Long
250    Const BUFFER_LENGTH = 256
251
252    iBuffLen = BUFFER_LENGTH
253    sBuffer = Space(BUFFER_LENGTH)
254    iReturn = GetTempPath(iBuffLen, sBuffer) '* get rid of the null character
255    HoldBuffer = Left$(sBuffer, iBuffLen - 1)
256    GetTempDir = Left$(HoldBuffer, InStr(HoldBuffer, vbNullChar) - 1)
257End Function
258
259Public Function GetDriveID() As String
260    GetDriveID = G_DriveID
261End Function
262
263Public Function SetDriveID(ByVal drive As String)
264    G_DriveID = drive
265End Function
266
267Public Function IsUnicodeFile(ByVal fname As String)
268   
269    Dim uniCode(0 To 1) As Byte
270    Dim Res() As String
271    Dim isUniCode As Boolean
272   
273    Open fname For Binary As #1
274   
275    Get #1, , uniCode
276   
277    isUniCode = False
278    If uniCode(0) = &HFF And uniCode(1) = &HFE Then
279        isUniCode = True
280    End If
281    Close #1
282   
283    IsUnicodeFile = isUniCode
284   
285End Function
286
287Public Function MapIndex(ByVal idxStr As String) As Integer
288   
289    idxStr = LCase(idxStr)
290   
291    If idxStr = "sel_usb_drv" Then
292        MapIndex = 0
293        Exit Function
294    End If
295   
296    If idxStr = "fmt_usb_drv" Then
297        MapIndex = 1
298        Exit Function
299    End If
300   
301    If idxStr = "pls_sel_usb_drv" Then
302        MapIndex = 2
303        Exit Function
304    End If
305   
306    If idxStr = "next" Then
307        MapIndex = 3
308        Exit Function
309    End If
310   
311    If idxStr = "exit" Then
312        MapIndex = 4
313        Exit Function
314    End If
315   
316    If idxStr = "usb_drv" Then
317        MapIndex = 5
318        Exit Function
319    End If
320   
321    If idxStr = "mk_usb_drv_boot" Then
322        MapIndex = 6
323        Exit Function
324    End If
325   
326    If idxStr = "sel_img" Then
327        MapIndex = 7
328        Exit Function
329    End If
330   
331    If idxStr = "inst_img" Then
332        MapIndex = 8
333        Exit Function
334    End If
335   
336    If idxStr = "browse" Then
337        MapIndex = 9
338        Exit Function
339    End If
340   
341    If idxStr = "pls_sel_arch_file" Then
342        MapIndex = 10
343        Exit Function
344    End If
345   
346    If idxStr = "usb_drv_boot" Then
347        MapIndex = 11
348        Exit Function
349    End If
350   
351    If idxStr = "close" Then
352        MapIndex = 12
353        Exit Function
354    End If
355   
356    If idxStr = "inst_ok" Then
357        MapIndex = 13
358        Exit Function
359    End If
360   
361    If idxStr = "confirm" Then
362        MapIndex = 14
363        Exit Function
364    End If
365   
366    If idxStr = "no_hp_fmt_tool" Then
367        MapIndex = 15
368        Exit Function
369    End If
370   
371    If idxStr = "pre" Then
372        MapIndex = 16
373        Exit Function
374    End If
375   
376    If idxStr = "sel_lang" Then
377        MapIndex = 17
378        Exit Function
379    End If
380   
381    MapIndex = -1
382End Function
383
384Public Function ParseUnicodeFile(ByVal fname As String) As String()
385   
386    Dim OutRec As String, uniCode As String, str() As String, Res() As String
387    ReDim Res(30)
388    Dim idx As Integer
389   
390    Open fname For Binary As #1
391
392    uniCode = InputB(2, #1)
393       
394    OutRec = ""
395   
396    Do While Not EOF(1)
397       
398        uniCode = InputB(2, #1)
399       
400        If EOF(1) Then
401           Exit Do
402        End If
403       
404        Select Case AscW(uniCode)
405            Case AscW(vbNewLine)
406                uniCode = InputB(2, #1)
407                             
408                If Trim$(OutRec) <> "" Then
409                   str = Split(OutRec, "=")
410                                     
411                   If UBound(str) > 0 Then
412                      idx = MapIndex(str(0))
413                     
414                      If idx >= UBound(Res) Then
415                         ReDim Res(UBound(Res) + idx + 10)
416                      End If
417                      Res(idx) = str(1)
418                   End If
419                End If
420                   
421                OutRec = ""
422            Case Else
423                OutRec = OutRec & uniCode
424               
425        End Select
426
427    Loop
428       
429   
430   
431    If Trim$(OutRec) <> "" Then
432        str = Split(OutRec, "=")
433             
434        If UBound(str) > 0 Then
435           Res(MapIndex(str(0))) = str(1)
436        End If
437    End If
438       
439    Close #1
440    ParseUnicodeFile = Res
441   
442End Function
443
444Public Function ParseAsciiFile(ByVal fname As String) As String()
445    Dim OutRec As String
446    Dim str() As String, Res() As String
447    ReDim Res(30)
448    Dim idx As Integer
449    Open fname For Binary As #1
450   
451   
452    Do While Not EOF(1)
453       
454        Line Input #1, OutRec
455       
456                   
457        If Trim$(OutRec) <> "" Then
458           str = Split(OutRec, "=")
459             
460           If UBound(str) > 0 Then
461              idx = MapIndex(str(0))
462              If idx >= UBound(Res) Then
463                 ReDim Res(UBound(Res) + idx + 10)
464              End If
465           
466              Res(idx) = str(1)
467           End If
468         End If
469
470    Loop
471   
472    Close #1
473   
474    ParseAsciiFile = Res
475   
476End Function
477
Note: See TracBrowser for help on using the repository browser.