Author |
Topic: XZIP DLL (Read 153 times) |
|
PabloSGL
New Member
member is offline
Posts: 5
|
 |
XZIP DLL
« Thread started on: Feb 16th, 2018, 5:07pm » |
|
Hello,
I am trying to use XZIP.DLL from
http://lbpe.wikispaces.com/ActiveX2#Using%20ActiveX%20DLLs%20in%20Liberty%20BASIC
This is the code I have been working on:
Part I
Code:
' Zip Archiver AciveX.dll Demo
' by Dennis McKinney
' Released as open source.
'** Created by LB Workshop - 2/10/2005 8:41:51 PM
'Listview and multi-select file dialog are based entirely or in
'part on code from the Liberty BASIC 4 Companion and LB Workshop,
'reprinted with permission.
'These invaluable tools are available at http://alycesrestaurant.com
'Note: minimal error checking is performed in this code.
' Added this two lines of code and named
' _LOCALE.SYSTEM.DEFAULT as LOCALE.SYSTEM.DEFAULT
LOCALE.SYSTEM.DEFAULT = hexdec("&H800")
global LOCALE.SYSTEM.DEFAULT
Nomainwin
OFNfilter$ = "Zip files" + Chr$(0) + "*.zip" + Chr$(0) + _
"All files" + Chr$(0) + "*.*" + Chr$(0) + Chr$(0)
TRUE = 1
AppName$ = "Zip Archiver Demo"
maxFiles = 1000
mainOpen = FALSE
Struct rect,_
left As Long,_
top As Long,_
right As Long,_
bottom As Long
Gosub [InitListView]
Gosub [InitCom]
Call BeginCOM
objZip = CreateObject("XStandard.Zip")
If Not(objZip) Then
Notice "Xzip not installed" + Chr$(13) + _
"The Xzip ActiveX dll has not been registered."
Goto [quit]
End If
WindowWidth = 500 : WindowHeight = 300
UpperLeftX = Int((DisplayWidth-WindowWidth)/2)
UpperLeftY = Int((DisplayHeight-WindowHeight)/2)
Menu #main, "&File", _
"&Open Archive", [archive.open], _
"&New Archive", [archive.new], _
"E&xit", [quit]
Menu #main, "&Actions", _
"&Add", [archive.add], _
"&Delete", [archive.delete], _
"&Extract All", [archive.extract], _
"&Select All", [archive.select.all]
stylebits #main, _WS_CLIPCHILDREN, 0, 0, 0
Open AppName$ For Window As #main
#main "trapclose [quit]"
#main "resizehandler [resizeWin]"
mainOpen = TRUE
hMain = Hwnd(#main)
hInst = GetWindowLong(hMain, _GWL_HINSTANCE)
style = _WS_CHILD Or _WS_VISIBLE Or _WS_CLIPCHILDREN _
Or LVS.NOSORTHEADER Or LVS.REPORT Or LVS.SHOWSELALWAYS
hLV = CreateListView(hMain, hInst, style, 0, 10, 100, 100)
r = ListView.InsertColumn(hLV, 0, 200, "Name")
r = ListView.InsertColumn(hLV, 1, 140, "Modified")
r = ListView.InsertColumn(hLV, 2, 70, "Size")
r = ListView.InsertColumn(hLV, 3, 300, "Path")
'Get the cursor associated with the listview
Calldll #user32, "GetClassLongA", hLV As Ulong, _
_GCL_HCURSOR As Long, hLVCursor As Ulong
[resizeWin]
Calldll #user32, "GetClientRect", hMain As Ulong, rect As Struct, r As Long
r=SetWindowPos(hLV, 0, 0, 0, rect.right.struct, rect.bottom.struct, 0)
[Loop]
Wait
[quit]
Call SetNothing objZip
Call EndCOM
Calldll #user32, "DestroyWindow", hLV As Long, r as Long
If mainOpen Then Close #main
End
[archive.new]
Filedialog "Enter a name for the new zip file", "*.zip", zipFile$
If (zipFile$ <> "") And (Right$(zipFile$,4) = ".zip") Then
If Not(PathExists(zipFile$)) Then
Call SetCaption hMain, AppName$ + ": " + file$(zipFile$)
Call ListView.DeleteAllItems hLV
ArchiveIsOpen = TRUE
Else
Notice "Error" + Chr$(13) + file$(zipFile$) + " already exists."
End If
Else
If (zipFile$ <> "") Then
Notice "Error" + Chr$(13) + _
zipFile$ + " is not a zip archive."
End If
End If
Wait
[archive.open]
Filedialog "Open a zip file", "*.zip", zipFile$
If (zipFile$ <> "") And (Right$(zipFile$,4) = ".zip") Then
Call SetCaption hMain, AppName$ + ": " + file$(zipFile$)
Call ShowZipFiles objZip, hLV, zipFile$
ArchiveIsOpen = TRUE
Else
If (zipFile$ <> "") Then
Notice "Error" + Chr$(13) + _
zipFile$ + " is not a zip archive."
End If
End If
Wait
[archive.add]
If ArchiveIsOpen = TRUE Then
bDlgCanceled = AddFileOptionsDlg(bPreservePaths)
If Not(bDlgCanceled) Then
fileList$ = GetOpenFileName$("Select file(s) to add to archive", _
path$, OFNfilter$, 2, TRUE)
If fileList$ <> "" Then
Gosub [cursor.hourglass]
If ParseOFNlist(fileList$, maxFiles) Then
filesAdded = FALSE
cnt = 0
While 1
tozip$ = OFNlist$(cnt)
cnt = cnt + 1
If tozip$ = "" Then Exit While
filesAdded = TRUE
If bPreservePaths Then
Call Zip.Pack.PreservePath objZip, tozip$, zipFile$
Else
Call Zip.Pack objZip, tozip$, zipFile$
End If
Wend
If filesAdded Then Call ShowZipFiles objZip, hLV, zipFile$
Else
Notice "Too many files selected" + chr$(13) + _
"Cannot add more than "+ str$(maxFiles) + " files at one time."
End If
Gosub [cursor.normal]
End If
End If
End If
Wait
[archive.extract]
'Is archive empty?
If GetArchiveFileCount(objZip, zipFile$) Then
EXTpath$ = BrowseForFolder$(hMain)
If EXTpath$ <> "" Then
Gosub [cursor.hourglass]
Call Zip.UnPack objZip, zipFile$, EXTpath$
Gosub [cursor.normal]
End If
End If
Wait
[archive.delete]
If ListView.GetSelectedCount(hLV) Then
Gosub [cursor.hourglass]
fileList$ = ListView.GetSelectedFiles$(hLV)
If ParseOFNlist(fileList$, maxFiles) Then
cnt = 0
While 1
delfile$ = OFNlist$(cnt)
cnt = cnt + 1
If delfile$ = "" Then Exit While
Call Zip.Delete objZip, delfile$, zipFile$
Wend
Call ShowZipFiles objZip, hLV, zipFile$
Else
Notice "Too many files selected" + chr$(13) + _
"Cannot delete more than "+ str$(maxFiles) + _
" selected files at one time." + chr$(13) + chr$(13) + _
"Select fewer files."
End If
Gosub [cursor.normal]
End If
Wait
[archive.select.all]
Call Listview.SelectAll hLV
Calldll #user32, "SetFocus", hLV As Ulong, r As Ulong
Wait
[cursor.hourglass]
Cursor hourglass
Calldll #user32, "SetClassLongA", hLV As Ulong, _
_GCL_HCURSOR As Long, _IDC_Wait As Long, r As Ulong
Return
[cursor.normal]
Cursor normal
Calldll #user32, "SetClassLongA", hLV As Ulong, _
_GCL_HCURSOR As Long, hLVCursor As Long, r As Ulong
Return
Function GetWindowLong(hWin, type)
Calldll #user32, "GetWindowLongA", hWin As Long, type As Long,_
GetWindowLong As Long
End Function
Function SetWindowPos(hWnd, pos, x, y, w, h, flags)
Calldll #user32, "SetWindowPos", hWnd As Ulong, pos As Long, _
x As Long, y As Long, w As Long, h As Long, flags As Long, r As Void
End Function
Sub SetCaption hWnd, capt$
Calldll #user32, "SetWindowTextA", hWnd As Ulong, capt$ As Ptr, r As Long
End Sub
|
|
 Logged
|
|
|
|
PabloSGL
New Member
member is offline
Posts: 5
|
|
Re: XZIP DLL
« Reply #1 on: Feb 16th, 2018, 5:11pm » |
|
Part II
Code:
Function file$(path$)
While Instr(path$,"\")
path$=Right$(path$,Len(path$)-1)
Wend
file$=path$
End Function
Function ParseOFNlist(strList$, maxElements)
'Fills array OFNlist$() with paths from a chr$(13) delimited string list
'or a single non-delimited path.
maxElements = max(maxElements, 1)
Redim OFNlist$(maxElements)
idx = 0
If Instr(strList$, Chr$(13)) Then
While 1
OFNlist$(idx) = Word$(strList$, idx+1, Chr$(13))
If OFNlist$(idx) = "" Then Exit While
idx = idx + 1
If idx > maxElements Then
Redim OFNlist$(1) 'erase the list
Exit Function 'return 0, failed
End If
Wend
Else
OFNlist$(0) = strList$
End If
If OFNlist$(0) <> "" Then ParseOFNlist = 1 'return success
End Function
Function GetOpenFileName$(title$, path$, filter$, filterIdx, multiselect)
'Returns a single file path or a chr$(13) delimited string of filepaths
OFN.EXPLORER = 524288
Struct ofn, _
lStructSize As Long, _
hwndOwner As Long, _
hInstance As Long, _
lpstrFilter$ As Ptr, _
lpstrCustomFilter$ As Ptr, _
nMaxCustFilter As Long, _
nFilterIndex As Long, _
lpstrFile$ As Ptr, _
nMaxFile As Long, _
lpstrFileTitle$ As Ptr, _
nMaxFileTitle As Long, _
lpstrInitialDir$ As Ptr, _
lpstrTitle$ As Ptr, _
Flags As Long, _
nFileOffset As Word, _
nFileExtension As Word, _
lpstrDefExt As Long, _
lCustData As Long, _
lpfnHook As Long, _
lpTemplateName As Long
ofn.lStructSize.struct = Len(ofn.struct)
ofn.lpstrFilter$.struct = filter$
ofn.nFilterIndex.struct = filterIdx
'Allow a lot of files to be chosen, 32000 characters
ofn.lpstrFile$.struct = Chr$(0) + Space$(32000) + Chr$(0)
ofn.nMaxFile.struct = 32000
ofn.lpstrInitialDir$.struct = path$ + Chr$(0)
ofn.lpstrTitle$.struct = title$ + Chr$(0)
ofn.lpstrDefExt.struct = 0
If multiselect = 1 Then
ofn.Flags.struct = _OFN_ALLOWMULTISELECT Or _OFN_PATHMUSTEXIST Or OFN.EXPLORER
Else
ofn.Flags.struct = _OFN_PATHMUSTEXIST Or OFN.EXPLORER
End If
Calldll #comdlg32, "GetOpenFileNameA", ofn As Struct, r As Long
If r Then
q$ = Chr$(34)
path$ = Winstring(ofn.lpstrFile$.struct)
ofnPath$ = Left$(path$,ofn.nFileOffset.struct)
If Right$(ofnPath$,1) <> "\" Then
ofnPath$ = ofnPath$ + "\"
End If
offset = ofn.lpstrFile$.struct + ofn.nFileOffset.struct
file$ = Winstring(offset)
GetOpenFileName$ = ofnPath$ + file$
If multiselect = 1 Then
If GetOpenFileName$ <> "" Then
GetOpenFileName$ = GetOpenFileName$ + Chr$(13)
End If
While file$<>""
offset = offset + Len(file$) + 1
file$ = Winstring(offset)
If file$<>"" Then
GetOpenFileName$ = GetOpenFileName$ + ofnPath$ + file$ + Chr$(13)
End If
Wend
End If
GetOpenFileName$ = Trim$(GetOpenFileName$)
Else
'User cancelled or error,
'see CommDlgExtendedError API.
End If
End Function
Function BrowseForFolder$(hWnd)
BIF.RETURNONLYFSDIRS = 1
Struct BrowseInfo,_
hWndOwner As Ulong,_
pIDLRoot As Ulong,_
pszDisplayName As Long,_
lpszTitle$ As Ptr,_
ulFlags As Long,_
lpfnCallback As Ulong,_
lParam As Long,_
iImage As Long
BrowseInfo.hWndOwner.struct = hWnd
BrowseInfo.lpszTitle$.struct = "Extract files to:"
BrowseInfo.ulFlags.struct = BIF.RETURNONLYFSDIRS
Calldll #shell32, "SHBrowseForFolder", BrowseInfo As Struct,_
lpIDList As Ulong
If lpIDList > 0 Then
sPath$ = Space$(_MAX_PATH)
Calldll #shell32, "SHGetPathFromIDList", lpIDList As Ulong,_
sPath$ As Ptr, success As Long
If success Then BrowseForFolder$ = Trim$(sPath$)
Open "ole32" For Dll As #ole32
Calldll #ole32, "CoTaskMemFree", lpIDList As Ulong, r As Long
Close #ole32
End If
End Function
Function AddFileOptionsDlg(Byref chk1)
chk1 = 0: bCanceled = 0
WindowWidth = 382 : WindowHeight = 150
Groupbox #AddFileDlg.group1, "Options", 30, 25, 200, 60
Button #AddFileDlg.ok, "Continue",[ok.click],UL, 250, 30, 105, 25
Button #AddFileDlg.cancel, "Cancel",[cancel.click],UL, 250, 60, 105, 25
Checkbox #AddFileDlg.chk1, "Preserve Paths",[chk1.click],[chk1.reset], 80, 45, 135, 25
stylebits #AddFileDlg, _DS_CENTER, 0, 0, 0
Open "Options - Add file(s) to zip archive" For Dialog_modal As #AddFileDlg
#AddFileDlg "trapclose [cancel.click]"
Wait
[ok.click]
Goto [quit.AddFileDlg]
[cancel.click]
bCanceled = 1
Goto [quit.AddFileDlg]
[chk1.click]
chk1 = 1: Wait
[chk1.reset]
chk1 = 0: Wait
[quit.AddFileDlg]
Close #AddFileDlg
AddFileOptionsDlg = bCanceled
End Function
Function PathExists(pathSpec$)
Struct PathExistsWFD, x As char[318]
Calldll #kernel32, "FindFirstFileA", pathSpec$ As Ptr, _
PathExistsWFD As Struct, hfind As Ulong
Calldll #kernel32, "FindClose", hfind As Ulong, ret As Long
If hfind <> _INVALID_HANDLE_VALUE Then PathExists = 1
End Function
'------------ Listview control routines ----------------
[InitListView]
LVS.NOSORTHEADER = 32768
LVS.REPORT = 1
LVS.SHOWSELALWAYS = 8
Struct LVCOLUMN, _
mask As Ulong, _
fmt As Long, _
cx As Long, _
pszText$ As Ptr, _
cchTextMax As Long, _
iSubItem As Long, _
iImage As Long, _
iOrder As Long
Struct LVITEM, _
mask As Ulong, _
iItem As Long, _
iSubItem As Long, _
state As Ulong, _
stateMask As Ulong, _
pszText$ As Ptr, _
cchTextMax As Long, _
iImage As Long, _
lParam As Long, _
iIndent As Long
Return
Function CreateListView(hParent, hInst, style, l, t, w, h)
Calldll #user32, "CreateWindowExA", _WS_EX_CLIENTEDGE As Long,_
"SysListView32" As Ptr, "" As Ptr, style As Long,_
l As Long, t As Long, w As Long, h As Long,_
hParent As Long, 0 As Long, hInst As Long,_
"" As Ptr, CreateListView As Ulong
End Function
Function ListView.InsertColumn(hLV, col, width, txt$)
LVM.INSERTCOLUMN = 4123
LVCF.WIDTH = 2
LVCF.TEXT = 4
LVCOLUMN.mask.struct = LVCF.WIDTH Or LVCF.TEXT
LVCOLUMN.cx.struct = width
LVCOLUMN.pszText$.struct = txt$
Calldll #user32, "SendMessageA", hLV As Long, LVM.INSERTCOLUMN As Long, _
col As Long, LVCOLUMN As Struct, ListView.InsertColumn As Long
End Function
Function ListView.InsertItem(hLV, row, col, txt$)
LVM.INSERTITEM = 4103
LVIF.TEXT = 1
LVITEM.mask.struct = LVIF.TEXT
LVITEM.iItem.struct = row
LVITEM.iSubItem.struct = col
LVITEM.pszText$.struct = txt$
Calldll #user32, "SendMessageA", hLV As Long, _
LVM.INSERTITEM As Long, 0 As Long, LVITEM As Struct, _
ListView.InsertItem As Long
End Function
Function ListView.SetItem(hLV, row, col, txt$)
LVM.SETITEM = 4102
LVIF.TEXT = 1
LVITEM.mask.struct = LVIF.TEXT
LVITEM.iItem.struct = row
LVITEM.iSubItem.struct = col
LVITEM.pszText$.struct = txt$
Calldll #user32, "SendMessageA", hLV As Long, _
LVM.SETITEM As Long, 0 As Long, LVITEM As Struct, _
ListView.SetItem As Long
End Function
Sub Listview.SelectAll hLV
LVIS.SELECTED = 2
LVM.SETITEMSTATE = 4139
LVITEM.stateMask.struct = LVIS.SELECTED
LVITEM.state.struct = LVIS.SELECTED
Calldll #user32, "SendMessageA", hLV As Long, _
LVM.SETITEMSTATE As Long, -1 As Long, _
LVITEM As Struct, r As Long
End Sub
Sub ListView.ClearAll hLV
LVIS.UNSELECTED = 0
LVIS.SELECTED = 2
LVM.SETITEMSTATE = 4139
LVITEM.stateMask.struct = LVIS.SELECTED
LVITEM.state.struct = LVIS.UNSELECTED
Calldll #user32, "SendMessageA", hLV As Long, _
LVM.SETITEMSTATE As Long, -1 As Long, _
LVITEM As Struct, r As Long
End Sub
Sub ListView.DeleteAllItems hLV
LVM.DELETEALLITEMS = 4105
Calldll #user32, "SendMessageA", hLV As Long, _
LVM.DELETEALLITEMS As Long, 0 As Long, _
0 As Long, r As Long
End Sub
Function ListView.GetSelectedCount(hLV)
LVM.GETSELECTEDCOUNT = 4146
Calldll #user32, "SendMessageA", hLV As Long, LVM.GETSELECTEDCOUNT As Long, _
0 As Long, 0 As Long, _
ListView.GetSelectedCount As Long
End Function
Function ListView.GetSelectedFiles$(hLV)
'Gets the selected files in the listview and
'returns them as a chr$(13) delimited list of filepaths.
LVM.GETSELECTEDCOUNT = 4146
LVM.GETNEXTITEM = 4108
LVNI.SELECTED = 2
LVM.GETITEMTEXTA = 4141
Calldll #user32, "SendMessageA", hLV As Long, LVM.GETSELECTEDCOUNT As Long, _
0 As Long, 0 As Long, _
ItemsSelected As Long
LVITEM.mask.struct = LVIF.TEXT
LVITEM.cchTextMax.struct = _MAX_PATH
LVITEM.pszText$.struct = Space$(_MAX_PATH)
'Start search at -1 so LVM.GETNEXTITEM will start at item 0.
SelectedItemIndex = -1
For index = 1 To ItemsSelected
Calldll #user32, "SendMessageA", hLV As Long, LVM.GETNEXTITEM As Long, _
SelectedItemIndex As Long, LVNI.SELECTED As Long, _
SelectedItemIndex As Long
'get the path
LVITEM.iSubItem.struct = 3
Calldll #user32, "SendMessageA", hLV As Long, LVM.GETITEMTEXTA As Long, _
SelectedItemIndex As Long, LVITEM As Struct, _
selItem As Long
path$=Winstring(LVITEM.pszText$.struct)
path$ = Trim$(path$)
If path$ <> "" Then items$ = items$ + path$
'get the file name
LVITEM.iSubItem.struct = 0 'first column
Calldll #user32, "SendMessageA", hLV As Long, LVM.GETITEMTEXTA As Long, _
SelectedItemIndex As Long, LVITEM As Struct, _
selItem As Long
file$=Winstring(LVITEM.pszText$.struct)
file$ = Trim$(file$)
If file$ <> "" Then items$ = items$ + file$ + Chr$(13)
Next index
ListView.GetSelectedFiles$ = items$
End Function
|
|
Logged
|
|
|
|
PabloSGL
New Member
member is offline
Posts: 5
|
|
Re: XZIP DLL
« Reply #2 on: Feb 16th, 2018, 5:11pm » |
|
Part III
Code:
'------------ COM and XZip.dll subs/functions ----------
[InitCom]
Struct comObj, obj As Ulong 'for receiving pointers to COM objects
Struct LVAL, x As Long 'for receiving numeric returns from COM methods
Struct STRVAL, x As Ptr 'for receiving string returns from COM methods
Return
Sub Zip.Pack XZipObject, src$, zip$
Calldll #com, "dhCallMethod", XZipObject As Ulong, ".Pack(%s, %s)" As Ptr,_
src$ As Ptr, zip$ As Ptr, r As Long
End Sub
Sub Zip.Pack.PreservePath XZipObject, src$, zip$
Calldll #com, "dhCallMethod", XZipObject As Ulong, ".Pack(%s, %s, %d)" As Ptr,_
src$ As Ptr, zip$ As Ptr, 1 As Long, r As Long
End Sub
Sub Zip.UnPack XZipObject, zip$, destination$
Calldll #com, "dhCallMethod", XZipObject As Ulong, _
".UnPack(%s, %s)" As Ptr, zip$ As Ptr, destination$ As Ptr, r As Long
End Sub
Sub Zip.Delete XZipObject, file$, zip$
Calldll #com, "dhCallMethod", XZipObject As Ulong, ".Delete(%s, %s)" As Ptr,_
file$ As Ptr, zip$ As Ptr, r As Long
End Sub
Sub ShowZipFiles XZipObject, hList, zipFile$
'Display a list of the files contained in the zip file
'along with their uncompressed size and any stored path.
'Display the files in a listview control.
tFolder = 1
tFile = 2
Call ListView.DeleteAllItems hList
Calldll #com, "dhGetValue", "%o" As Ptr, comObj As Struct, _
XZipObject As Ulong, ".Contents(%s)" As Ptr, zipFile$ As Ptr, r As Long
objItems = comObj.obj.struct: comObj.obj.struct = 0
count = GetValueLong(objItems, ".Count")
For Idx = 1 To count
Calldll #com, "dhGetValue", "%o" As Ptr, comObj As Struct, _
objItems As Ulong, ".Item(%d)" As Ptr, Idx As Long, r As Long
objItem = comObj.obj.struct: comObj.obj.struct = 0
If GetValueLong(objItem, ".Type") = tFile Then
listIdx = listIdx + 1
fileName$ = GetValueStr$(objItem, ".Name")
fileTime$ = GetValueDateTime$(objItem, ".Date")
fileSize = GetValueLong(objItem, ".Size")
filePath$ = GetValueStr$(objItem, ".Path")
r = ListView.InsertItem(hList, listIdx-1, 0, fileName$)
r = ListView.SetItem(hList, listIdx-1, 1, fileTime$)
r = ListView.SetItem(hList, listIdx-1, 2, Str$(fileSize))
r = ListView.SetItem(hList, listIdx-1, 3, filePath$)
End If
Call SetNothing objItem
Next Idx
Call SetNothing objItems
End Sub
Function GetArchiveFileCount(XZipObject, zipFile$)
Calldll #com, "dhGetValue", "%o" As Ptr, comObj As Struct, _
XZipObject As Ulong, ".Contents(%s)" As Ptr, zipFile$ As Ptr, r As Long
objItems = comObj.obj.struct: comObj.obj.struct = 0
GetArchiveFileCount = GetValueLong(objItems, ".Count")
Call SetNothing objItems
End Function
Sub BeginCOM
Open "oleaut32.dll" For Dll As #ole
Open "LB_dispHelper.dll" For Dll As #com
Calldll #com, "dhInitializeCom", FALSE As Long, r As Long
Calldll #com, "dhToggleExceptions", 1 As Long, r As Long
End Sub
Sub EndCOM
Close #ole
Calldll #com, "Uninitialize_COM", 1 As Long, r As Void
Close #com
End Sub
Function CreateObject(ObjName$)
'Create an instance of ObjName$ on the local machine
ObjName$ = ObjName$ + Chr$(0)
Calldll #com, "dhCreateObject", ObjName$ As Ptr, _NULL As Long, _
comObj As Struct, r As Ulong
CreateObject = comObj.obj.struct: comObj.obj.struct = 0
End Function
Sub SetNothing Object
Calldll #com, "dhReleaseObject", Object As Ulong, r As Void
End Sub
Function GetValueStr$(Object, item$)
STRVAL.x.struct = ""
Calldll #com, "dhGetValue", "%s" As Ptr, STRVAL As Struct, _
Object As Ulong, item$ As Ptr, r As Long
GetValueStr$ = Winstring(STRVAL.x.struct)
x=STRVAL.x.struct: Calldll #com, "FreeString", x As Ulong, r As Void
End Function
Function GetValueLong(Object, item$)
LVAL.x.struct = 0
Calldll #com, "dhGetValue", "%d" As Ptr, LVAL As Struct, _
Object As Ulong, item$ As Ptr, r As Long
GetValueLong = LVAL.x.struct
End Function
Function GetValueDateTime$(Object, item$)
TIME.NOSECONDS = 2
Struct DT, x As Double
Struct st, _ 'SYSTEMTIME
wYear As Word, _
wMonth As Word, _
wDayOfWeek As Word, _
wDay As Word, _
wHour As Word, _
wMinute As Word, _
wSecond As Word, _
wMilliseconds As Word
Calldll #com, "dhGetValue", "%D" As Ptr, DT As Struct, _
Object As Ulong, item$ As Ptr, r As Long
vtDate = DT.x.struct
Calldll #ole, "VariantTimeToSystemTime", vtDate As Double, st As Struct, r As Long
dtBuf$ = Space$(50)
Calldll #kernel32, "GetDateFormatA", LOCALE_SYSTEM_DEFAULT As Ulong, _
_NULL As Ulong, st As Struct, _NULL As Ulong, dtBuf$ As Ptr, 50 As Long, _
dt$ = Left$(dtBuf$,r-1)
dtBuf$ = Space$(50)
Calldll #kernel32, "GetTimeFormatA", LOCALE_SYSTEM_DEFAULT As Ulong, _
TIME.NOSECONDS As Ulong, st As Struct, _NULL As Ulong, dtBuf$ As Ptr, 50 As Long, _
r As Long
tm$ = Left$(dtBuf$,r-1)
GetValueDateTime$ = dt$ + " " + tm$
End Function
|
|
Logged
|
|
|
|
PabloSGL
New Member
member is offline
Posts: 5
|
|
Re: XZIP DLL
« Reply #3 on: Feb 16th, 2018, 5:15pm » |
|
I get this error "Missing AS in CALLDLL". If somebody can make this to work I will be eternally grateful
Thank you.
Best regards,
- Pablo Sighel
|
|
Logged
|
|
|
|
Richard Russell
Administrator
member is offline
Posts: 1348
|
|
Re: XZIP DLL
« Reply #4 on: Feb 16th, 2018, 6:31pm » |
|
on Feb 16th, 2018, 5:11pm, PabloSGL wrote: Code: dtBuf$ = Space$(50)
Calldll #kernel32, "GetDateFormatA", LOCALE_SYSTEM_DEFAULT As Ulong, _
_NULL As Ulong, st As Struct, _NULL As Ulong, dtBuf$ As Ptr, 50 As Long, _
dt$ = Left$(dtBuf$,r-1) |
|
According to your comments you changed the Windows Constant to LOCALE.SYSTEM.DEFAULT (dots) but here it still has underscores. Did you change it using Edit... Replace... Replace all? That should have replaced all occurrences in the program, so I don't understand how these were missed.
Richard.
|
|
Logged
|
|
|
|
PabloSGL
New Member
member is offline
Posts: 5
|
|
Re: XZIP DLL
« Reply #5 on: Feb 16th, 2018, 8:51pm » |
|
Oops!, sorry!!!
I did not see the difference between _LOCALE_SYSTEM_DEFAULT and LOCALE.SYSTEM.DEFAULT (the DOTs)
You know what they say:"BASIC programmers are blind, because they can´t C"
FIXED! Thanks!!!
- Pablo
|
|
Logged
|
|
|
|
Richard Russell
Administrator
member is offline
Posts: 1348
|
|
Re: XZIP DLL
« Reply #6 on: Feb 16th, 2018, 9:22pm » |
|
on Feb 16th, 2018, 8:51pm, PabloSGL wrote:| I did not see the difference between _LOCALE_SYSTEM_DEFAULT and LOCALE.SYSTEM.DEFAULT |
|
It's a peculiarity of Liberty BASIC that underscores are legal in Windows constants but not in variable names, whereas dots are legal in variable names but not in Windows constants (at least, there are no Windows constants containing dots).
I think you can claim the prize for discovering the first Windows constant that is known about by LB 4 but not by LBB. When creating LBB I had to 'guess' which constants to include and which not to include, and when there is a difference it is usually the other way around (i.e. LBB knows about it but LB 4 doesn't).
Sadly for you, there isn't really a prize! Sorry.
Richard.
|
|
Logged
|
|
|
|
|
