mainfrm.frm

比WinZip速度快很多的SINE256加密算法模块。支持指定密钥

    Dlg.ShowOpen
    Path = Dlg.Filename
    '#########################
    '####Get path to save#####
    Dlg.DialogTitle = "Enter path to save file"
    Dlg.ShowOpen
    SavePath = Dlg.Filename
    '#########################
    If Not SavePath = "" And Not Path = "" Then
    
        Dim xVal() As Byte 'Buffer variable
        Dim segment As Double 'Number of segment Fix(Size / buffer) + 1
        Dim FileL As Double 'Length of the file
        FileL = LengthOfFile(Path) 'Set length of file
        segment = Fix(FileL / Chunk) + 1 'Set Number of segment
        Dim i As Double 'Variable used to loop (also the position in the segment)
        st = GetTickCount ' sT is the starting gettickcount value . Used for statistics
        Dim Freenum As Integer 'File number of the file to encrypt/decrypt
        Freenum = FreeFile 'Initialize file number
        Dim Freenum2 As Integer 'File number of the path to save
        Dim Str As String
        Open Path For Binary Access Read As #Freenum 'Open the first path before giving file number to save path (otherwise you will get same value for both)
        Freenum2 = FreeFile 'Now you can give him a number
        Open SavePath For Binary Access Write As #Freenum2 'Initialize the save path
        For i = 1 To segment 'Loop in the file buffers (Segment)
            Dim PercentX As Double 'Variable holding percent value (Statistics)
            Dim TimeRemain As Double 'Variable holding time remaining (Statistics)
            Dim FilePos As Double 'Variable holding the file position NOT IN SEGMENT, IN CHARACTER LENGTH VALUE
            Dim Speed As String 'Variable holding the speed per second in Mb (Statistics)
            TimeRemain = GetTimeRemaining(FileL, Chunk, st, i) 'Get time remaining value (Statistics)
            PercentX = GetPercent(i, segment) 'Get percent value (Statistics)
            Speed = GetSpeed(st, Chunk, i)
            FilePos = i * Chunk 'Number of segment * Characters in a segment
            If i * Chunk > FileL Then
                FilePos = FileL ' Just so it cant go over the file length
            End If
            'This line just show stats in the form caption
            MainFrm.Caption = "SINE256 Visualisation And Sample Console... Decrypting Segment (" & i & "/" & segment & ") (" & FilePos & "/" & FileL & ") (" & PercentX & "%) Time Remaining : " & TimeRemain & "s (Speed : " & Speed & "/s)"
            Dim Bnd As Double 'Buffer calculation (Make sure it doesnt use the full buffer on the last segment which is very rare is the same size as the others)
            If i = segment Then
                Bnd = FileL - (Chunk * (i - 1)) 'Its the last segment so let calculate its real size
            Else
                Bnd = Chunk 'Full buffer
            End If
            ReDim xVal(0 To (Bnd - 1)) 'Resize the Byte array variable
            DoEvents
            If Not EOF(Freenum) Then 'If end of file isnt reached(in case of very exceptionnal error)
                Get #Freenum, , xVal() 'Get data from file with the byte array size which is Bnd
                DoEvents
                cl.SINE256Decrypt xVal(), Res(), password, PatternLen 'Encrypt/Decrypt the current Segment
                DoEvents
                Put #Freenum2, , Res() 'Save Result to the save path
                DoEvents
            End If
        Next ' Loop through i

        Close #Freenum 'Close file (It is now usable)
        Close #Freenum2 'Close file (It is now usable)

         MsgBox "Finished! File length was " & FileL & " characters. Encrypted/Decrypted at " & Round((1000 / (GetTickCount - st)) * FileL) & "Chrs per second", vbInformation

    End If
xStop:
Encrypt.Enabled = True 'Make button possible to use
Decrypt.Enabled = True 'Make button possible to use
EncryptFile.Enabled = True 'Make button possible to use
DecryptFile.Enabled = True 'Make button possible to use
End Sub

Private Sub EncryptFile_Click()
Encrypt.Enabled = False 'Make button impossible to use
Decrypt.Enabled = False 'Make button impossible to use
EncryptFile.Enabled = False 'Make button impossible to use
DecryptFile.Enabled = False 'Make button impossible to use
DoEvents
    'Master variables initializing
    Dim Path As String 'Var holding path of file to encrypt or decrypt
    Dim SavePath As String 'Var holding the save path
    Dim st As Long 'Var holding value of GetTickCount when action start (Statistics)
    Dim Crypt() As Byte 'Variable getting file data (This var get resized and get different size of the file for optimization)
    Dim Res() As Byte 'This is same as Crypt() but its the datas once encrypted (Array is gonna be EXACT SAME SIZE)
    'Show Unused in stats frame
    StatsLbl(0).Caption = "Unused" 'Show that those kind of stats arent used with files
    StatsLbl(1).Caption = "Unused" 'Show that those kind of stats arent used with files
    StatsLbl(2).Caption = "Unused" 'Show that those kind of stats arent used with files
    StatsLbl(3).Caption = "Unused" 'Show that those kind of stats arent used with files
    '###Get file to encrypt###
    Dlg.DialogTitle = "Select File to Encrypt/Decrypt"
    Dlg.ShowOpen
    Path = Dlg.Filename
    '#########################
    '####Get path to save#####
    Dlg.DialogTitle = "Enter path to save file"
    Dlg.ShowOpen
    SavePath = Dlg.Filename
    '#########################
    If Not SavePath = "" And Not Path = "" Then
    
        Dim xVal() As Byte 'Buffer variable
        Dim segment As Double 'Number of segment Fix(Size / buffer) + 1
        Dim FileL As Double 'Length of the file
        FileL = LengthOfFile(Path) 'Set length of file
        segment = Fix(FileL / Chunk) + 1 'Set Number of segment
        Dim i As Double 'Variable used to loop (also the position in the segment)
        st = GetTickCount ' sT is the starting gettickcount value . Used for statistics
        Dim Freenum As Integer 'File number of the file to encrypt/decrypt
        Freenum = FreeFile 'Initialize file number
        Dim Freenum2 As Integer 'File number of the path to save
        Dim Str As String
        Open Path For Binary Access Read As #Freenum 'Open the first path before giving file number to save path (otherwise you will get same value for both)
        Freenum2 = FreeFile 'Now you can give him a number
        Open SavePath For Binary Access Write As #Freenum2 'Initialize the save path
        For i = 1 To segment 'Loop in the file buffers (Segment)
            Dim PercentX As Double 'Variable holding percent value (Statistics)
            Dim TimeRemain As Double 'Variable holding time remaining (Statistics)
            Dim FilePos As Double 'Variable holding the file position NOT IN SEGMENT, IN CHARACTER LENGTH VALUE
            Dim Speed As String 'Variable holding the speed per second in Mb (Statistics)
            TimeRemain = GetTimeRemaining(FileL, Chunk, st, i) 'Get time remaining value (Statistics)
            PercentX = GetPercent(i, segment) 'Get percent value (Statistics)
            Speed = GetSpeed(st, Chunk, i)
            FilePos = i * Chunk 'Number of segment * Characters in a segment
            If i * Chunk > FileL Then
                FilePos = FileL ' Just so it cant go over the file length
            End If
            'This line just show stats in the form caption
            MainFrm.Caption = "SINE256 Visualisation And Sample Console... Crypting Segment (" & i & "/" & segment & ") (" & FilePos & "/" & FileL & ") (" & PercentX & "%) Time Remaining : " & TimeRemain & "s (Speed : " & Speed & "/s)"
            Dim Bnd As Double 'Buffer calculation (Make sure it doesnt use the full buffer on the last segment which is very rare is the same size as the others)
            If i = segment Then
                Bnd = FileL - (Chunk * (i - 1)) 'Its the last segment so let calculate its real size
            Else
                Bnd = Chunk 'Full buffer
            End If
            ReDim xVal(0 To (Bnd - 1)) 'Resize the Byte array variable
            DoEvents
            If Not EOF(Freenum) Then 'If end of file isnt reached(in case of very exceptionnal error)
                Get #Freenum, , xVal() 'Get data from file with the byte array size which is Bnd
                DoEvents
                cl.SINE256Encrypt xVal(), Res(), password, PatternLen 'Encrypt/Decrypt the current Segment
                DoEvents
                Put #Freenum2, , Res() 'Save Result to the save path
                DoEvents
            End If
        Next ' Loop through i

        Close #Freenum 'Close file (It is now usable)
        Close #Freenum2 'Close file (It is now usable)

         MsgBox "Finished! File length was " & FileL & " characters. Encrypted/Decrypted at " & Round((1000 / (GetTickCount - st)) * FileL) & "Chrs per second", vbInformation

    End If
xStop:
Encrypt.Enabled = True 'Make button possible to use
Decrypt.Enabled = True 'Make button possible to use
EncryptFile.Enabled = True 'Make button possible to use
DecryptFile.Enabled = True 'Make button possible to use
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Unload Me
End Sub

Private Sub Form_Terminate()
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub



'If you wanna study this encryption ignore the module and everything in here but the encrypt and decrypt button
Private Sub RefreshBaseGraph_Click()
    Dim Xb() As Double
    'This draw the algorithm in a graph (This is the base stuff, nothing is mixed yet)
    Xb() = cl.MakeGraph(decal, start, rangE, PatternLen) 'Initialize the graphic in the class and in the graphic (NEED TO BE INITIALIZED AT LEAST ONCE FOR IT TO WORK)
    ChartIt2 AlgoChart, Xb() 'Refresh the top graph
End Sub

Private Sub SettingCmd_Click()
    SettingFrm.Show
    SettingFrm.SetFocus
End Sub

Private Sub SwapCmd_Click()
    t1.Text = t2.Text 'Simply move text to another text box
    t2.Text = ""
End Sub


Private Sub Decrypt_Click() 'No need to explain , its same as encrypt sub but with the decrypt function
Encrypt.Enabled = False
Decrypt.Enabled = False
EncryptFile.Enabled = False
DecryptFile.Enabled = False
DoEvents
Dim st As Long
If Not t1.Text = "" Then
    Dim Dcrypt() As Byte
    Dim Res() As Byte
    st = GetTickCount
    Dcrypt() = StrConv(t1.Text, vbFromUnicode)
    StatsLbl(0).Caption = GetTickCount - st & "ms"
    st = GetTickCount
    cl.SINE256Decrypt Dcrypt(), Res(), password, PatternLen
    StatsLbl(1).Caption = GetTickCount - st & "ms"
    Dim R As String
    st = GetTickCount
    R = StrConv(Res, vbUnicode)
    StatsLbl(2).Caption = GetTickCount - st & "ms"
    st = GetTickCount
    t2.Text = R
    t1.Text = ""
    StatsLbl(3).Caption = GetTickCount - st & "ms"
End If
Encrypt.Enabled = True
Decrypt.Enabled = True
EncryptFile.Enabled = True
DecryptFile.Enabled = True
End Sub

Private Sub Encrypt_Click()
Encrypt.Enabled = False
Decrypt.Enabled = False
EncryptFile.Enabled = False
DecryptFile.Enabled = False
DoEvents
Dim st As Long
If Not t1.Text = "" Then
    Dim Graph As Boolean
    Select Case MsgBox("Do you want to draw the datas in the graph ? Careful, very long strings can freeze the program. Only use for string under 5000 character for safety.", vbYesNo)
    Case 6 'He clicked YES
        Graph = True
    Case 7 'He clicked No
        Graph = False
    End Select
    Dim Crypt() As Byte 'Variable holding datas to encrypt (need to be in bytes)
    Dim Res() As Byte 'Variable holding the encrypted Data (need to be in bytes)
    st = GetTickCount
    Crypt = StrConv(t1.Text, vbFromUnicode) 'Convert the text in the text box into Bytes array (Its fast!)
    StatsLbl(0).Caption = GetTickCount - st & "ms"
    st = GetTickCount
    cl.SINE256Encrypt Crypt(), Res(), password, PatternLen 'Let's my module convert the stuff
    StatsLbl(1).Caption = GetTickCount - st & "ms"
    st = GetTickCount
    Dim Dat As String
    Dat = StrConv(Res, vbUnicode)
    StatsLbl(2).Caption = GetTickCount - st & "ms"
    st = GetTickCount
    DoEvents
    If Graph = True Then
        ChartIt TextChart, Crypt 'Draw the stuff in the graph
        ChartIt CryptChart, Res 'Draw the stuff in the graph
    End If
    t2.Text = Dat 'Show string
    t1.Text = ""
    StatsLbl(3).Caption = GetTickCount - st & "ms"
End If
Encrypt.Enabled = True
Decrypt.Enabled = True
EncryptFile.Enabled = True
DecryptFile.Enabled = True
End Sub

Private Sub Form_Load()

    Dim z(0 To 1) As Long 'Used to clear the graph with the annoying starting datas
    AlgoChart.ChartData = z 'Clear graph3
    TextChart.ChartData = z 'Clear graph2
    CryptChart.ChartData = z 'Clear graph1
    PatternLen = 50000 'Give patternLen as starting value
    decal = 1 'Give the decal a starting value
    start = 128 'Give the start a starting value
    rangE = 128 'Give the range a starting value
    Chunk = 1048576 'Give buffer size a starting value
        
        ChartIt2 AlgoChart, cl.MakeGraph(decal, start, rangE, PatternLen)
End Sub


Private Sub t1_Change()
    ChrLenLbl.Caption = Len(t1.Text)
End Sub

Private Sub t2_Change()
    ResLenLbl.Caption = Len(t2.Text)
End Sub