[vb6] TEXT File Encryptor

[Rockage]

Heh I was bored one day :P Learn From it.

PHP Code:

Function Encrypt(infile As String) As Boolean
    Dim Fileno1 As Integer
    Dim Fileno2 As Integer
    Dim outfile As String
    Dim xpos As Long
    Dim x As Byte
    
    MousePointer = vbHourglass
    
    xpos = 4
    outfile = "c:\temp.enc"
    Fileno1 = FreeFile
    Open infile For Binary As Fileno1
        Fileno2 = FreeFile
        Open outfile For Binary As Fileno2
            Put #Fileno2, 1, 0
            Put #Fileno2, 2, 128
            Put #Fileno2, 3, 0
            Put #Fileno2, 4, 128
            Do While Not EOF(Fileno1)
                xpos = xpos + 1
                Get #Fileno1, xpos, x
                Put #Fileno2, xpos, x + 128
            Loop
        Close Fileno2
    Close Fileno1
    
    Kill infile
    FileCopy outfile, infile
    Kill outfile
    Encrypt = True
    
    MousePointer = vbNormal
End Function
Private Function Decrypt(infile As String) As Boolean
    Dim Fileno1 As Integer
    Dim Fileno2 As Integer
    Dim outfile As String
    Dim xpos As Long
    Dim x As Byte
    Dim t(3) As Byte
    
    MousePointer = vbHourglass
    
    xpos = 4
    outfile = "c:\temp.enc"
    Fileno1 = FreeFile
    Open infile For Binary As Fileno1
        Fileno2 = FreeFile
        Open outfile For Binary As Fileno2
            Get #Fileno2, 1, t(0)
            Get #Fileno2, 2, t(1)
            Get #Fileno2, 3, t(2)
            Get #Fileno2, 4, t(3)
            If (t(o) = 0 And t(1) = 128 And t(2) = 0 And t(3) = 128) Then
                Open Oufile For Binary As Fileno2
                Do While Not EOF(Fileno1)
                    xpos = xpos + 1
                    Get #Fileno1, xpos, x
                    Put #Fileno2, xpos, -128
            Loop
        Close Fileno2
        Decrypt = True
    Else
        Decrypt = False
    Close Fileno1
    
    If Decrypt Then
    Kill infile
        FileCopy outfile, infile
        Kill outfile
    End If
    
    MousePointer = vbNormal
    End If
End Function

Function GetFile() As String
    dlgFile.CancelError = True
    On Error GoTo Filerr
    
    dlgFile.DialogTitle = "Select a File..."
    dlgFile.DefaultExt = "*.txt"
    dlgFile.Filter = "Text FIles (*.txt)|*.txt|" & " All Files (*.*)|*.*"
    dlgFile.FilterIndex = 1
    dlgFile.MaxFileSize = 32767
    
    dlgFile.ShowOpen
    
    GetFile = dlgFile.filename
    
    Exit Function
Filerr:
    GetFile = ""
End Function


Private Sub mnuActDecrypt_Click()
    Dim filename As String
    filename = GetFile()
    If filename <> "" Then
        If Decrypt(filename) = False Then
            MsgBox "Error Decrypting File"
        End If
    End If
End Sub


Private Sub mnuActEncrypt_Click()
    Dim filename As String
    filename = GetFile()
    If filename <> "" Then
        If Encrypt(filename) = False Then
            MsgBox "Error Encrypting File!"
        End If
    End If
End Sub 


[Zachafer]

Does the Decrypt work this time?

[Rockage]

yes. you know what. If all your going to do is comment my s**t and say bad things than f**k you man. Im a better programmer than you, stop trying to act cool.

[Aethean]

Originally Posted by Rockage

yes. you know what. If all your going to do is comment my s**t and say bad things than f**k you man. Im a better programmer than you, stop trying to act cool.

He just asked if it worked...

Originally Posted by Rockage

yes. you know what. If all your going to do is comment my s**t and say bad things than f**k you man. Im a better programmer than you, stop trying to act cool.

Programming Battle!

[Rockage]

Programming Battle!

Bring it. Zachafer cant program for s**t by himself. He'd probably rip w/e he did make from pscode or some program book.

He just asked if it worked...

read between the lines. Its an immature attempt to hurt me.

[Aethean]

Originally Posted by Rockage

Bring it. Zachafer cant program for s**t by himself. He'd probably rip w/e he did make from pscode or some program book.



read between the lines. Its an immature attempt to hurt me.

Does the Decrypt work this time?

I dont quite see it.. can you explain how it was an attempt to hurt you

[Rockage]

I dont quite see it.. can you explain how it was an attempt to hurt you

Sure can. I have gotten zach banned at a number of other forums for ripping code from sites. He had just sent me a message on msn saying something like "text file encryptor, read my response " and I said ok. Hes just trying to make me look as bad as him. If you dont get that sorry, I cant really explain it, but I find it quite obvious.

[Underdog]

Originally Posted by Rockage

Sure can. I have gotten zach banned at a number of other forums for ripping code from sites. He had just sent me a message on msn saying something like "text file encryptor, read my response " and I said ok. Hes just trying to make me look as bad as him. If you dont get that sorry, I cant really explain it, but I find it quite obvious.

it's called a cyber bully, just laugh at the lifeless losers like that and move on

there's 2 cases here, either a. he's wondering if it works because he admires your programming skills and is interested in it, or b. he's pathetically making a sarcastic comment in attempts to boost his own confidence

[Bump J]

LMAO at zachafer

learn more about vb before you talk shit