makecabでCab圧縮
-----------解説--------------------------------------------
XP_proのコマンドプロンプトでmakecab /?
とすると以下の情報が得られます。
この情報を元に、
VB6でバッチフィルを作成し、実行するプログラムです。
Microsoft (R) Cabinet Maker - Version 5.1.2600.0
Copyright (c) Microsoft Corporation. All rights reserved..
MAKECAB [/V[n]] [/D var=value ...] [/L dir] source [destination]
MAKECAB [/V[n]] [/D var=value ...] /F directive_file [...]
source File to compress.
destination File name to give compressed file. If omitted, the
last character of the source file name is replaced
with an underscore (_) and used as the destination.
/F directives A file with MakeCAB directives (may be repeated).
/D var=value Defines variable with specified value.
/L dir Location to place destination (default is current directory).
/V[n] Verbosity level (1..3).
フォームへ記入
プロジェクトの始まりスタートは、モジュールから行うようにする。
プロジェクトのプロパティーでSub Mainをスタートアップに指定する。
Option Explicit
Dim clo As Long
Public Sub 実行()
'実行
Dim ret バッチファイルを実行する
ret = Shell(App.Path & "\圧縮実行.bat")
Do
DoEvents
Loop Until clo = 20
Unload Form1
End Sub
Private Sub Timer1_Timer()
clo = clo + 1
Form1.ProgressBar1.Value = Form1.ProgressBar1.Value + 5
End Sub
|
モジュールへ記入
Attribute VB_Name = "Press"
Option Explicit
Dim stBatTxt As String
Sub Main() 'ここからプログラムが始まる
stBatTxt = "" '一応初期化しておく
'ドラッグドロップしたファイルのフルパスが「Command$」にはいる。
If Command$ = "" Then
Exit Sub
End If
Dim stret As String
'文字列として作成していく 「"文字列"」として取得される
stret = NewNuki(Command$)
' stret = NewNuki("C:\Documents and Settings\kouji\デスクトップ\vb6compress\1readme")
' Debug.Print "makecab " & """" & Trim("C:\Documents and Settings\kouji\デスクトップ\vb6compress\1readme") & """" & " " & """" & Trim(stret) & """"
'これでBAT文字列を作成する
stBatTxt = "makecab " & Trim(Command$) & " " & """" & Trim(stret) & """"
' MsgBox Trim(stret)
'これは何をしているのだっけ?
stBatTxt = Replace(stBatTxt, vbCrLf, "", , 1)
'バッチフィルを作成
Dim FileNum As Integer
FileNum = FreeFile
'batファイル作成
Open App.Path & "\圧縮実行.bat" For Output As #FileNum
Print #FileNum, stBatTxt
Close #FileNum
Form1.Show 0
Form1.実行
'バッチファイルを消しておく
Kill App.Path & "\圧縮実行.bat"
End Sub
Private Function NewNuki(ByVal moji As String) As String
'とにかく一番後ろの\の後の文字を取得する
Dim splitStr() As String
Dim lngstr As Long '配列の最大の添字
Dim kaku As Long
'配列に取得
splitStr() = Split(moji, "\")
'配列の最大の添字を取得 SP6でモリリークはなくなったのかな?
lngstr = UBound(splitStr)
If InStr(splitStr(lngstr), ".") <> 0 Then
'. 拡張子があれば それ以降をcabにする
kaku = InStr(splitStr(lngstr), ".")
NewNuki = App.Path & "\" & Left(splitStr(lngstr), kaku - 1) & ".cab"
Else
'拡張子がなければ.cabをつけ足す
NewNuki = App.Path & "\" & Left(splitStr(lngstr), Len(splitStr(lngstr)) - 1) & ".cab"
End If
End Function
|
© 2004 I Love Balard. All Rights Reserved.
|