「ファイル圧縮してみよう」の編集履歴（バックアップ）一覧はこちら

「ファイル圧縮してみよう」(2010/01/24 (日) 15:48:13) の最新版変更点

追加された行は緑色になります。

削除された行は赤色になります。

[[Common Archivers Library>http://www.csdinc.co.jp/archiver/]]
からCAB32.DLL 開発者 SDK v0.98をダウソしましゅ。

展開して、cab32.dllを、システムホルダに投入します。

ABのプロジェクトでウインドウにリストボックス（ID=ListBox1）とボタン（ID=CommandButton1）
だけの画面を作ります。このとき、MainWndの拡張スタイルでドラッグ＆ドロップを許可にします。

イカのコードをコピペします。終わり。
 '-----------------------------------------------------------------------------
 '  イベント プロシージャ
 '-----------------------------------------------------------------------------
 ' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
 ' ウィンドウ ハンドル: hMainWnd
 
 ' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
 Declare Function Cab Lib"cab32" (hwnd As HWND, cmdl As *Byte, outp As *Byte, si As DWord) As Long
 
 Const CabCmd = "-a -ml:21"
 Const ResFile = "平井公彦.log"
 Const CabFile = "平井公彦.cab"
 
 '-----------------------------------------------------------------------------
 ' ウィンドウメッセージを処理するためのコールバック関数
 
 Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
   ' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
 
   ' イベントプロシージャの呼び出しを行います。
   MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
 End Function
 
 
 '-----------------------------------------------------------------------------
 ' ここから下は、イベントプロシージャを記述するための領域になります。
 
 Sub MainWnd_Destroy()
   Cab2_DestroyObjects()
   PostQuitMessage(0)
 End Sub
 
 'ダロップ
 Sub MainWnd_DropFiles(hDrop As HDROP)
   Dim k As Long, j As Long
   Dim file[MAX_PATH] As Byte
   k = DragQueryFile(hDrop, -1,NULL,0)
   For j=0 To k-1
     DragQueryFile(hDrop,j,file,MAX_PATH)
     SendMessage(GetDlgItem(hMainWnd,ListBox1), LB_ADDSTRING, 0, file)
   Next
   DragFinish(hDrop)
 End Sub
 
 '圧縮ボタン
 Sub MainWnd_CommandButton1_Click()
   Dim ccmd[1000] As Byte
   Dim re[1000] As Byte
   Dim f[MAX_PATH] As Byte
   Dim hF As HANDLE
   Dim w As DWord,j As Long, k As Long,l As Long
 
   'レスポンスファイルを作る
   hF = CreateFile(ResFile, GENERIC_WRITE, 0, ByVal 0, CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0)
   k = SendMessage(GetDlgItem(hMainWnd, ListBox1), LB_GETCOUNT,0,0)
   For j=0 To k-1
     l = SendMessage(GetDlgItem(hMainWnd, ListBox1),LB_GETTEXT,j,f)  
     wsprintf(ccmd, Ex"\q%s\q\r\n", f)
     WriteFile(hF, ccmd, lstrlen(ccmd), VarPtr(w), ByVal 0)
   Next
   CloseHandle(hF)
 
   'Cab実行
   wsprintf(ccmd, "%s %s @%s", CabCmd, CabFile, ResFile)
   Cab(hMainWnd, ccmd, re, 999)
   Kill ResFile
   MessageBox(hMainWnd, re, "mes", MB_OK)
 End Sub

[[Common Archivers Library>http://www.csdinc.co.jp/archiver/]]
からCAB32.DLL 開発者 SDK v0.98をダウソしましゅ。

展開して、cab32.dllを、システムホルダに投入します。

ABのプロジェクトでウインドウにリストボックス（ID=ListBox1）とボタン（ID=CommandButton1）
だけの画面を作ります。このとき、MainWndの拡張スタイルでドラッグ＆ドロップを許可にします。

イカのコードをコピペします。終わり。
 '-----------------------------------------------------------------------------
 '  イベント プロシージャ
 '-----------------------------------------------------------------------------
 ' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
 ' ウィンドウ ハンドル: hMainWnd
 
 ' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
 Declare Function Cab Lib"cab32" (hwnd As HWND, cmdl As *Byte, outp As *Byte, si As DWord) As Long
 
 Const CabCmd = "-a -ml:21"
 Const ResFile = "平井公彦.log"
 Const CabFile = "平井公彦.cab"
 
 '-----------------------------------------------------------------------------
 ' ウィンドウメッセージを処理するためのコールバック関数
 
 Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
   ' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。
 
   ' イベントプロシージャの呼び出しを行います。
   MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
 End Function
 
 
 '-----------------------------------------------------------------------------
 ' ここから下は、イベントプロシージャを記述するための領域になります。
 
 Sub MainWnd_Destroy()
   Cab2_DestroyObjects()
   PostQuitMessage(0)
 End Sub
 
 'ダロップ
 Sub MainWnd_DropFiles(hDrop As HDROP)
   Dim k As Long, j As Long
   Dim file[MAX_PATH] As Byte
   k = DragQueryFile(hDrop, -1,NULL,0)
   For j=0 To k-1
     DragQueryFile(hDrop,j,file,MAX_PATH)
     SendMessage(GetDlgItem(hMainWnd,ListBox1), LB_ADDSTRING, 0, file)
   Next
   DragFinish(hDrop)
 End Sub
 
 '圧縮ボタン
 Sub MainWnd_CommandButton1_Click()
   Dim ccmd[1000] As Byte
   Dim re[1000] As Byte
   Dim f[MAX_PATH] As Byte
   Dim hF As HANDLE
   Dim w As DWord,j As Long, k As Long,l As Long
 
   'レスポンスファイルを作る
   hF = CreateFile(ResFile, GENERIC_WRITE, 0, ByVal 0, CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,0)
   k = SendMessage(GetDlgItem(hMainWnd, ListBox1), LB_GETCOUNT,0,0)
   For j=0 To k-1
     l = SendMessage(GetDlgItem(hMainWnd, ListBox1),LB_GETTEXT,j,f)  
     wsprintf(ccmd, Ex"\q%s\q\r\n", f)
     WriteFile(hF, ccmd, lstrlen(ccmd), VarPtr(w), ByVal 0)
   Next
   CloseHandle(hF)
 
   'Cab実行
   wsprintf(ccmd, "%s %s @%s", CabCmd, CabFile, ResFile)
   Cab(hMainWnd, ccmd, re, 999)
   Kill ResFile
   MessageBox(hMainWnd, re, "mes", MB_OK)
 End Sub

注意:プロジェクト名をCab2にしないとコンパイルが通らないという猛烈なバグがあります。