frmmain.frm

对ima、imz压缩文件修改

VERSION 5.00
Begin VB.Form frmMain 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "WimaSDK Test Application"
   ClientHeight    =   3195
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5670
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   5670
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton tbCreateNew 
      Caption         =   "Create .IMZ on the fly, then write to diskette"
      Height          =   645
      Left            =   90
      TabIndex        =   6
      Top             =   1710
      Width           =   1995
   End
   Begin VB.CommandButton btnQuit 
      Caption         =   "&Quit the Test"
      Height          =   375
      Left            =   90
      TabIndex        =   4
      Top             =   2700
      Width           =   1995
   End
   Begin VB.CommandButton btnCreateIMZFile 
      Caption         =   "Create .IMZ from A: Disk"
      Height          =   330
      Left            =   90
      TabIndex        =   3
      Top             =   495
      Width           =   1995
   End
   Begin VB.CommandButton btnCreateIMAFile 
      Caption         =   "Create .IMA from A: Disk"
      Height          =   330
      Left            =   90
      TabIndex        =   2
      Top             =   135
      Width           =   1995
   End
   Begin VB.CommandButton btnCreateIMZ 
      Caption         =   "Create Disk from .IMZ"
      Enabled         =   0   'False
      Height          =   330
      Left            =   90
      TabIndex        =   1
      Top             =   1260
      Width           =   1995
   End
   Begin VB.CommandButton btnCreateIMA 
      Caption         =   "Create Disk from .IMA"
      Enabled         =   0   'False
      Height          =   330
      Left            =   90
      TabIndex        =   0
      Top             =   900
      Width           =   1995
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "Label1"
      Height          =   2940
      Left            =   2250
      TabIndex        =   5
      Top             =   135
      Width           =   3300
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Wimadll Test Application for VB5

' Written by Graham Lemon, 6/8/98 to demonstrate how to implement WIMADLL.DLL into
' VB5 project. (contact: [e-mail])

' From original BASIC demo code by Gilles Vollant.

' v1.00.00 - Creates IMA/IMZ files from diskette in A:, Creates Diskette from resulting IMA/IMZ
'                 also creates IMZ on-the-fly and then writes a diskette from it.

' More to be added as required... Gilles?

'------------------------------------------------------------------------------------------------------------

' Module level declarations for subs below
 Dim fCpr As Boolean                            ' Var to take result of file read TRUE= Compressed
 Dim dwPos As Long                              ' Offset into File
 Dim Ima As Long                                 ' Memory buffer handle
 Dim res As Boolean                              ' Function result var - Test for Errorhandling
 Dim res2 As Boolean                            ' Another result var
 Dim ent As Long                                  ' Var to hold number of entries in directory
 Dim str As String                                 ' General string variable
 Dim strsav As String                           ' String for name of target File

Private Sub btnCreateIMA_Click()
    
    str = App.Path & "\test.imz"      ' Call file from same dir as application
    CreateDisk (str)
End Sub

Private Sub btnCreateIMAFile_Click()

    str = App.Path & "\test.ima"
    CreateFile str, False               ' FALSE = NO Compression
    btnCreateIMA.Enabled = True
End Sub
Private Sub btnCreateIMZFile_Click()

    str = App.Path & "\test.imz"
    CreateFile str, True                ' TRUE = Compress File
    btnCreateIMZ.Enabled = True
End Sub

Private Sub btnCreateIMZ_Click()

    str = App.Path & "\test.imz"      ' Call file from same dir as application
    CreateDisk str
End Sub

' CreateFile: - Creates an image, compressed or otherwise
Sub CreateFile(FileName As String, Compressed As Boolean)
    
    Ima = CreateMemFatHima()
    res = ReadFloppy(Ima, Me.hWnd, A_DRIVE, FL_USED)
    If Compressed Then
        res = WriteImaFile(Ima, Me.hWnd, str, False, True, 9, 0, "")
    Else
        res = WriteImaFile(Ima, Me.hWnd, str, False, False, 9, 0, "")
    End If
    res = SetLabel(Ima, "TEST")
    DeleteIma (Ima)
End Sub

'CreateDisk: - Creates a diskette from an image file
Sub CreateDisk(FileName As String)
    
    Ima = CreateMemFatHima()                                                             ' Creates memory buffer for .IMA/.IMZ file
    res = ReadImaFile(Ima, Me.hWnd, FileName, fCpr, dwPos)                  ' Reads .IMA/.IMZ file into memory
    Me.Refresh                                                                                      ' Repaint form after progress dialog disappears
    res = WriteFloppy(Ima, Me.hWnd, 0, FL_NOTHING, FL_USED, FL_USED, True)  ' Write to FDD, ignoring slack space
    DeleteIma Ima                                                                               ' Deletes memiory image of .IMA/.IMZ file
End Sub

' CreateNew: - This button causes an image file to be generated from nothing, has
' files added to it, then writes the resulting image to the Hard drive as a .IMZ. Lastly
' it takes this image and creates a diskette
Private Sub tbCreateNew_Click()

    Ima = CreateMemFatHima()
    res = MakeEmptyImage(Ima, 6)    ' Type 6 = 1.44Mb
    SetLabel Ima, "ONTHEFLY"
    ent = GetNbEntryCurDir(Ima)
    res = InjectFile(Ima, "c:\config.sys", dwPos, fCpr, "config.sys")
    res = InjectFile(Ima, "c:\command.com", dwPos, fCpr, "COMMAND.COM")
    strsav = App.Path & "\onthefly.imz"
    res = WriteImaFile(Ima, Me.hWnd, strsav, True, True, 9, 0, "onthefly.ima")
    DeleteIma Ima
    Ima = 0             ' Reset  IMA and ...
    dwPos = 0          ' ... dwPos as they are used in the 'CreateDisk' function
    
    ' Now to prove it, write it to FDD
    CreateDisk (strsav)
    MsgBox "Check the disk in A:, it should contain config.sys and command.com. The program just generated an image file on the fly and wrote it to your diskette!", vbInformation, "WimaDLL Test"
End Sub

Private Sub btnQuit_Click()
    Unload Me
End Sub

Private Sub Form_Load()

    Dim SysDir As String
    Dim Exists As Boolean

    Label1.Caption = "Each of the buttons on your left exercises a part of the WimaSDK DLL" & _
                             " and makes calls from VB5 to the DLL supplied by Gilles. " & vbCr & vbCr & _
                             "You should make a .IMA first, which willl be called 'test.ima' " & _
                             " Similarly, making a .IMZ file will result in a compressed image of the diskette " & _
                             "in drive A: and will be called 'test.imz'" & vbCr & vbCr & _
                             "There is little error checking in this test, so please ensure you have a diskette of" & _
                             " the right size in the A: drive when you come to create the diskettes using the" & _
                             " 3rd and 4th buttons" & vbCr & vbCr & "THIS ASSUMES A: is 1.44Mb!!!"
    ' Remove test images if the prog has been run before
    On Error Resume Next
    Kill App.Path & "\test.ima"
    Kill App.Path & "\test.imz"
    Kill App.Path & "\onthefly.imz"
    On Error GoTo 0
    ' This would normally be part of the application setup routine, but...
    ' Does WimaDLL.DLL exist in WinSysDir?
    SysDir = GetWindowsSysDir
    If Len(SysDir) > 0 Then
        On Error Resume Next
        Open "wimadll.dll" For Input As #1
        Exists = IIf(Err = 0, True, False)
        Close #1
        On Error GoTo 0
    Else
        MsgBox "Cannot resolve your Windows SYSTEM directory, please copy wimadll.dll to that location and then restart this demo", vbCritical, "WimaDLL Test Application"
        Unload Me
    End If
    If Not Exists Then
        ' if the file is not alreadt in winsysdir, need to copy DLL
        ' as VB5 will not find it in the app directory
        FileCopy App.Path & "\wimadll.dll", SysDir & "\wimadll.dll"
    End If
End Sub

'GetWindowsSysDir: - Helper function, calls into Win API to get SysDir
Private Function GetWindowsSysDir() As String

    Dim strBuf As String
    Dim IntZeroPos As Integer
    
    strBuf = Space$(MAXLFN)
    If GetSystemDirectory(strBuf, MAXLFN) > 0 Then
        IntZeroPos = InStr(strBuf, Chr$(0))
        If IntZeroPos > 0 Then
            strBuf = Left$(strBuf, IntZeroPos - 1)
        End If
        GetWindowsSysDir = strBuf
    Else
        GetWindowsSysDir = ""
    End If
End Function