home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Homam_Anti21381012252008.psc / Appender / frmMain.frm < prev    next >
Text File  |  2008-12-17  |  7KB  |  241 lines
  1. VERSION 5.00
  2. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  3. Begin VB.Form frmMain 
  4.    BackColor       =   &H00FFFFFF&
  5.    BorderStyle     =   3  'Fixed Dialog
  6.    Caption         =   "Homam File Appender"
  7.    ClientHeight    =   2370
  8.    ClientLeft      =   45
  9.    ClientTop       =   435
  10.    ClientWidth     =   5250
  11.    BeginProperty Font 
  12.       Name            =   "Tahoma"
  13.       Size            =   8.25
  14.       Charset         =   178
  15.       Weight          =   400
  16.       Underline       =   0   'False
  17.       Italic          =   0   'False
  18.       Strikethrough   =   0   'False
  19.    EndProperty
  20.    Icon            =   "frmMain.frx":0000
  21.    LinkTopic       =   "Form1"
  22.    LockControls    =   -1  'True
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    ScaleHeight     =   2370
  26.    ScaleWidth      =   5250
  27.    StartUpPosition =   2  'CenterScreen
  28.    Begin VB.CommandButton cmdBrowse 
  29.       Caption         =   "..."
  30.       Height          =   300
  31.       Index           =   1
  32.       Left            =   4880
  33.       TabIndex        =   9
  34.       Top             =   465
  35.       Width           =   300
  36.    End
  37.    Begin VB.CommandButton cmdBrowse 
  38.       Caption         =   "..."
  39.       Height          =   300
  40.       Index           =   0
  41.       Left            =   4880
  42.       TabIndex        =   8
  43.       Top             =   105
  44.       Width           =   300
  45.    End
  46.    Begin MSComDlg.CommonDialog CommonDialog1 
  47.       Left            =   4800
  48.       Top             =   1920
  49.       _ExtentX        =   847
  50.       _ExtentY        =   847
  51.       _Version        =   393216
  52.       CancelError     =   -1  'True
  53.    End
  54.    Begin VB.TextBox txtOut 
  55.       Height          =   285
  56.       Left            =   600
  57.       Locked          =   -1  'True
  58.       TabIndex        =   7
  59.       Text            =   "Fill both text boxes first"
  60.       Top             =   1080
  61.       Width           =   4230
  62.    End
  63.    Begin VB.TextBox txtFile 
  64.       Height          =   285
  65.       Index           =   1
  66.       Left            =   600
  67.       TabIndex        =   5
  68.       Top             =   480
  69.       Width           =   4230
  70.    End
  71.    Begin VB.TextBox txtFile 
  72.       Height          =   285
  73.       Index           =   0
  74.       Left            =   600
  75.       TabIndex        =   3
  76.       Top             =   120
  77.       Width           =   4230
  78.    End
  79.    Begin VB.CommandButton cmdExit 
  80.       BackColor       =   &H80000005&
  81.       Cancel          =   -1  'True
  82.       Caption         =   "Exit"
  83.       Height          =   375
  84.       Left            =   1110
  85.       TabIndex        =   1
  86.       Top             =   1920
  87.       Width           =   975
  88.    End
  89.    Begin VB.CommandButton cmdStart 
  90.       BackColor       =   &H80000005&
  91.       Caption         =   "Start"
  92.       Default         =   -1  'True
  93.       Enabled         =   0   'False
  94.       Height          =   375
  95.       Left            =   120
  96.       TabIndex        =   0
  97.       Top             =   1920
  98.       Width           =   975
  99.    End
  100.    Begin VB.Label Label3 
  101.       BackStyle       =   0  'Transparent
  102.       Caption         =   "Out:"
  103.       Height          =   255
  104.       Left            =   120
  105.       TabIndex        =   6
  106.       Top             =   1110
  107.       Width           =   495
  108.    End
  109.    Begin VB.Label Label2 
  110.       BackStyle       =   0  'Transparent
  111.       Caption         =   "File2:"
  112.       Height          =   255
  113.       Left            =   120
  114.       TabIndex        =   4
  115.       Top             =   510
  116.       Width           =   495
  117.    End
  118.    Begin VB.Label Label1 
  119.       BackStyle       =   0  'Transparent
  120.       Caption         =   "File1:"
  121.       Height          =   255
  122.       Left            =   120
  123.       TabIndex        =   2
  124.       Top             =   150
  125.       Width           =   495
  126.    End
  127.    Begin VB.Line Line1 
  128.       X1              =   0
  129.       X2              =   7560
  130.       Y1              =   1800
  131.       Y2              =   1800
  132.    End
  133. End
  134. Attribute VB_Name = "frmMain"
  135. Attribute VB_GlobalNameSpace = False
  136. Attribute VB_Creatable = False
  137. Attribute VB_PredeclaredId = True
  138. Attribute VB_Exposed = False
  139. '
  140. ' By Homam Babi - 2008
  141. ' humam_babi@hotmail.com
  142. '
  143. Option Explicit
  144. Option Base 1
  145. Private Sub cmdBrowse_Click(Index As Integer)
  146.     On Local Error Resume Next
  147.     CommonDialog1.ShowOpen
  148.     
  149.     If Err Then
  150.         Err.Clear
  151.         Exit Sub
  152.     End If
  153.     
  154.     txtFile(Index) = CommonDialog1.FileName
  155. End Sub
  156. Private Sub cmdExit_Click()
  157.     End
  158. End Sub
  159. Private Sub Form_Load()
  160.     SetIcon Me.hwnd, "AAA", True
  161. End Sub
  162. Private Sub cmdStart_Click()
  163.     
  164.     If FileExists(txtFile(0).Text) = False Then
  165.         MsgBox "Can't find file:" & vbNewLine & txtFile(0).Text
  166.         Exit Sub
  167.     End If
  168.     If FileExists(txtFile(1).Text) = False Then
  169.         MsgBox "Can't find file:" & vbNewLine & txtFile(1).Text
  170.         Exit Sub
  171.     End If
  172.     If FileExists(txtOut.Text) = True Then
  173.         If MsgBox("will OutFile be overwritten?", vbApplicationModal Or vbDefaultButton2 Or vbQuestion Or vbYesNo) = vbNo Then
  174.             Exit Sub
  175.         End If
  176.     End If
  177.     
  178.     cmdStart.Enabled = False
  179.     cmdExit.Enabled = False
  180.     txtFile(0).Enabled = False
  181.     txtFile(1).Enabled = False
  182.     txtOut.Enabled = False
  183.     
  184.     Dim Dat() As Byte
  185.     Dim vSize1 As Long
  186.     Dim vSize2 As Long
  187.     
  188.     If FileExists(txtOut.Text) = True Then Kill txtOut.Text: DoEvents
  189.     
  190.     Open txtOut.Text For Binary Access Write As #1
  191.         vSize1 = FileLen(txtFile(0).Text)
  192.         vSize2 = FileLen(txtFile(1).Text)
  193.         
  194.         Put #1, , vSize1
  195.         Put #1, , vSize2
  196.         
  197.         Open txtFile(0).Text For Binary Access Read As #2
  198.             ReDim Dat(1 To vSize1)
  199.             Get #2, , Dat
  200.         Close #2
  201.         Put #1, , Dat
  202.         
  203.         Open txtFile(1).Text For Binary Access Read As #2
  204.             ReDim Dat(1 To vSize2)
  205.             Get #2, , Dat
  206.         Close #2
  207.         Put #1, , Dat
  208.     Close #1
  209.     
  210.     MsgBox "Mission accomplished!", vbApplicationModal Or vbInformation Or vbOKOnly
  211.     
  212.     cmdExit.Enabled = True
  213.     cmdStart.Enabled = True
  214.     txtFile(0).Enabled = True
  215.     txtFile(1).Enabled = True
  216.     txtOut.Enabled = True
  217. End Sub
  218. Private Sub txtFile_Change(Index As Integer)
  219.     If (Len(Trim$(txtFile(0))) > 0) And (Len(Trim$(txtFile(1))) > 0) Then
  220.         txtOut.Text = App.Path & IIf(Left$(App.Path, 1) <> "\", "\", "") & "Data.hav"
  221.         cmdStart.Enabled = True
  222.     Else
  223.         txtOut.Text = "Fill both text boxes first"
  224.         cmdStart.Enabled = False
  225.     End If
  226.     
  227. End Sub
  228. Private Function FileExists(ByVal strPathName As String) As Boolean
  229.     Dim intFileNum As Integer
  230.  
  231.     On Error Resume Next
  232.  
  233.     intFileNum = FreeFile
  234.     Open strPathName For Input As intFileNum
  235.         FileExists = (Err.Number = 0)
  236.     Close intFileNum
  237.  
  238.     Err.Clear
  239. End Function
  240.  
  241.