tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
[ツリー表示へ]  [ワード検索]  [Home]

タイトル Re^9: VB.netによる圧縮
投稿日: 2005/08/31(Wed) 10:26
投稿者ageha
[OSのVer]:Windows    [VBのVer]:VB.NET  
またお世話になります。
ソース貼り付けます。↓
VB.NET(VS2003-windows2000)
Private Sub Form1_DragDrop(ByVal sender As Object, ByVal e As
System.Windows.Forms.DragEventArgs) Handles MyBase.DragDrop
        Dim f2 As New Example
        f2.ShowDialog(Me)
        'D&Dされたのがフォルダかファイルかを調べるメソッド
        For Each FileName As String In CType(e.Data.GetData(DataFormats.FileDrop, True),
String())
            If (GetAttr(FileName) And FileAttribute.Directory) = FileAttribute.Directory Then
                Call CompDir(Me.Handle.ToInt32, FileName, "C:\7zip.7z")
            ElseIf SevenZipCheckArchive(FileName, 1) = 0 Then
                Call CompFile(FileName)
            End If
        Next
    End Sub
    Private Sub Form1_DragEnter(ByVal sender As Object, ByVal e As
System.Windows.Forms.DragEventArgs) Handles MyBase.DragEnter
        If e.Data.GetDataPresent(DataFormats.FileDrop, True) Then
            '「ファイル」のドロップを許可
            e.Effect = DragDropEffects.Copy
        Else
            '「ファイル以外」のドロップを禁止
            e.Effect = DragDropEffects.None
        End If
    End Sub
    'ディレクトリ処理
    Public Function CompDir(ByVal hWnd As Long, ByVal strTargetDir As String, ByVal
strTargetZip As String) As Long

        Dim strCommand As String
        Dim strOut As String
        Dim nSize As Long
        Dim sevenZipOpt As String
        strOut = Space(512)
        nSize = 512

        If Dir(strTargetDir, FileAttribute.Normal) <> "" Then
            '上書き確認処理
            MsgBox(strTargetDir & "すでに存在しています。" & vbCrLf & &
quot;ファイルを上書きします
か?" & vbCrLf & "(はいで上書き,いいえで圧縮中止)", MsgBoxStyle.YesNo
+
MsgBoxStyle.Information, "上書き確認")
        End If

        sevenZipOpt = "-t7z -m0=LZMA "
        strCommand = "a -r " & sevenZipOpt & Chr(34) & strTargetZip &am
p; Chr(34) & " " & Chr(34)
& strTargetDir & "\" & Chr(34) & " *.*"

        CompDir = SevenZip(hWnd, strCommand, strOut, nSize)

        If CompDir <> 0 Then
            '失敗メッセージ
            MsgBox("圧縮に失敗しました。")
        Else
            MsgBox("圧縮成功しました。")
        End If
    End Function
一部抜粋するとこんな感じです。今は新しく作り直しましたが、未だに現象が続きます。
よろしく願います。

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。