LB Booster - XZIP DLL

LB Booster

General

General Board (Moderator: Richard Russell)

XZIP DLL

« Previous Topic | Next Topic »

Pages: 1

Author

Topic: XZIP DLL (Read 154 times)

PabloSGL
New Member

member is offline

Posts: 5

XZIP DLL
« Thread started on: Feb 16^th, 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 16^th, 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 16^th, 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 16^th, 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 16^th, 2018, 6:31pm »

on Feb 16^th, 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 16^th, 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 16^th, 2018, 9:22pm »

on Feb 16^th, 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

Pages: 1


« Previous Topic \| Next Topic »