Archive

Archive for May, 2009

compare the contents of two

May 23, 2009 programmervb 2 comments

‘Description: Compares the content of two files

Open “file1″ For Binary As #1
Open “file2″ For Binary As #2
issame% = True
If LOF(1) <> LOF(2) Then
issame% = False
Else
whole& = LOF(1) \ 10000         ‘number of whole 10,000 byte chunks
part& = LOF(1) Mod 10000        ‘remaining bytes at end of file
buffer1$ = String$(10000, 0)
buffer2$ = String$(10000, 0)
start& = 1
For x& = 1 To whole&            ‘this for-next loop will get 10,000
Get #1, start&, buffer1$      ‘byte chunks at a time.
Get #2, start&, buffer2$
If buffer1$ <> buffer2$ Then
issame% = False
Exit For
End If
start& = start& + 10000
Next
buffer1$ = String$(part&, 0)
buffer2$ = String$(part&, 0)
Get #1, start&, buffer1$        ‘get the remaining bytes at the end
Get #2, start&, buffer2$        ‘get the remaining bytes at the end
If buffer1$ <> buffer2$ Then issame% = False
End If
Close
If issame% Then
MsgBox “Files are identical”, 64, “Info”
Else
MsgBox “Files are NOT identical”, 16, “Info”
End If

Categories: Information

Encryption Methode

'in a Module
' Encryption Methode
Function Enkripsi(word As String) As String
Dim temp, temp2 As Integer
Dim temp3, temp4, temp5 As String
' file enkription
If Len(word > 0) Then
    ReDim CharacterValue(Len(word) - 1) As Byte
    For i = 0 To (Len(word) - 1)
    temp = Asc(Mid(word, i + 1, 1)) + 77
    If (temp > 255) Then temp = temp - 255
    CharacterValue(i) = CByte(temp)
    Next i

End If
End Function

'In a Form
' Encryption Methode by Jery M
Private Sub Form_Load()

End Sub

Private Sub Label1_Change()
Dim CriptVariable As Integer
Dim StringBuffer As String

If Len(Label1.Caption) > 0 Then
    'change data from label1 back to ke label3
    ReDim CharacterValue(Len(Label1.Caption) - 1) As Byte
    For i = 0 To (Len(Label1.Caption) - 1)
    CriptVariable = Asc(Mid(Label1.Caption, i + 1, 1)) - 77
    If CriptVariable < 0 Then CriptVariable = CriptVariable + 255
    CharacterValue(i) = CByte(CriptVariable)
    Next i
    'show it in label3
    StringBuffer = vbNullString
    For i = 0 To (Len(Label1.Caption) - 1)
    StringBuffer = StringBuffer & Chr(CharacterValue(i))
    Next i
    Label3.Caption = StringBuffer

Else
    MsgBox "empty"
End If
End Sub

Private Sub Text1_Change()
Dim CriptVariable As Integer
Dim StringBuffer As String
'Ambil data yang akan dan dienkripsi

If Len(Text1.Text) > 0 Then
    ReDim CharacterValue(Len(Text1.Text) - 1) As Byte
    For i = 0 To (Len(Text1.Text) - 1)
    CriptVariable = Asc(Mid(Text1.Text, i + 1, 1)) + 77
    If (CriptVariable > 255) Then CriptVariable = CriptVariable - 255
    CharacterValue(i) = CByte(CriptVariable)
    Next i
    'show encryption in label1
    StringBuffer = vbNullString
    For i = 0 To (Len(Text1.Text) - 1)
    StringBuffer = StringBuffer & Chr(CharacterValue(i))
    Next i
    Label1.Caption = StringBuffer
   Else
    Label1.Caption = vbNullString
End If
End Sub
Categories: Application Tags:

Common Dialog File Properties Called With API

‘Description: Invokes the File Explorer “Properties” dialog without OCX

‘Type SHELLEXECUTEINFO
‘       cbSize As Long
‘       fMask As Long
‘       hwnd As Long
‘       lpVerb As String
‘       lpFile As String
‘       lpParameters As String
‘       lpDirectory As String
‘       nShow As Long
‘       hInstApp As Long
‘       lpIDList As Long ‘Optional parameter
‘       lpClass As String ‘Optional parameter
‘       hkeyClass As Long ‘Optional parameter
‘       dwHotKey As Long ‘Optional parameter
‘       hIcon As Long ‘Optional parameter
‘       hProcess As Long ‘Optional parameter
‘End Type

‘Const SEE_MASK_INVOKEIDLIST = &HC
‘Const SEE_MASK_NOCLOSEPROCESS = &H40
‘Const SEE_MASK_FLAG_NO_UI = &H400

‘Declare Function ShellExecuteEX Lib “shell32.dll” Alias “ShellExecuteEx” _
        (SEI As SHELLEXECUTEINFO) As Long

‘Public Function ShowProperties(filename As String, OwnerhWnd As Long) As Long

       
       ‘     ‘open a file properties property page for specified file if return value
       ‘     ‘<=32 an error occurred
       ‘     ‘From: Delphi code provided by “Ian Land” (iml@dircon.co.uk)
       Dim SEI As SHELLEXECUTEINFO
       Dim r As Long
       
       ‘     ‘Fill in the SHELLEXECUTEINFO structure
       With SEI
       .cbSize = Len(SEI)
       .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
       .hwnd = OwnerhWnd
       .lpVerb = “properties”
       .lpFile = filename
       .lpParameters = vbNullChar
       .lpDirectory = vbNullChar
       .nShow = 0
       .hInstApp = 0
       .lpIDList = 0
End With

 
‘     ‘call the API
r = ShellExecuteEX(SEI)
 
‘     ‘return the instance handle as a sign of success
ShowProperties = SEI.hInstApp
 
‘End Function
‘Paste the following into a command button, etc.
‘Needs one textbox named Text1

        Dim r As Long
        Dim fname As String
       ‘      ‘get the filename and path from Text1
        fname = (Text1)
       ‘      ’show the properties dialog, passing the filename
       ‘      ‘and the owner of the dialog
        r = ShowProperties(fname, Me.hwnd)
       
       ‘      ‘Display an error message if things didn’t go as planned
        If r <= 32 Then MsgBox “Error”

Categories: info