needs help .....urgent

[aseel20006]

hello there ...

l do have a project of implementing an IR Moden which is communicate with the computer through serial port and l have difficulties on implementing the code sending a file and encrypte the signal....

l use vb8 and the encryption code is vb5 ... so how can l modify it to be applicable with vb8

[aseel20006]

the code is as follow

Attribute VB_Name = "ModEncDec"
Public Function Encrypt(ByVal Plain As String, _
  sEncKey As String) As String
    '*********************************************************
    'Coded WhiteKnight 6-1-00
    'This Encrypts A string by converting it to its ASCII number
    'but the difference is it uses a Key String it converts the
    'keystring to ASCII and adds it to the first ASCII Value the
    'key is needed to decrypt the text.  I do plan on changing
    'this some what but For Now its ok.  I've only seen it
    'cause an error when the wrong Key was entered while
     'decrypting.
    
    'Note That If you use the same letter more then 3 times in a
    'row then each letter after it if still the same is ignored
    '(ie aaa = aaaaaaaaa but aaa <> aaaza)
    'If anyone Can figure out a way to fix this please e-mail me
  '*********************************************************
    Dim encrypted2 As String
    Dim LenLetter As Integer
    Dim Letter As String
    Dim KeyNum As String
    Dim encstr As String
    Dim temp As String
    Dim temp2 As String
    Dim itempstr As String
    Dim itempnum As Integer
    Dim Math As Long
    Dim i As Integer
    
    On Error GoTo oops
    
    If sEncKey = "" Then sEncKey = "WhiteKnight"
    'Sets the Encryption Key if one is not set
    ReDim encKEY(1 To Len(sEncKey))
    
    'starts the values for the Encryption Key
        
    For i = 1 To Len(sEncKey$)
     KeyNum = Mid$(sEncKey$, i, 1) 'gets the letter at index i
     encKEY(i) = Asc(KeyNum) 'sets the the Array value
                             'to ASC number for the letter

           'This is the first letter so just hold the value
        If i = 1 Then Math = encKEY(i): GoTo nextone

        'compares the value to the previous value and then
        'either adds/subtracts the value to the Math total
       If i >= 2 And Math - encKEY(i) >= 0 And encKEY(i) <= _
           encKEY(i - 1) Then Math = Math - encKEY(i)

        If i >= 2 And Math - encKEY(i) >= 0 And encKEY(i) <= _
           encKEY(i - 1) Then Math = Math - encKEY(i)
        If i >= 2 And encKEY(i) >= Math And encKEY(i) >= _
           encKEY(i - 1) Then Math = Math + encKEY(i)
        If i >= 2 And encKEY(i) < Math And encKEY(i) _
          >= encKEY(i - 1) Then Math = Math + encKEY(i)
nextone:
    Next i
    
    
    For i = 1 To Len(Plain) 'Now for the String to be encrypted
        Letter = Mid$(Plain, i, 1) 'sets Letter to
                                   'the letter at index i
        LenLetter = Asc(Letter) + Math 'Now it adds the Asc
                                       'value of Letter to Math

'checks and corrects the format then adds a space to separate them frm each other
        If LenLetter >= 100 Then encstr = _
             encstr & Asc(Letter) + Math & " "

         'checks and corrects the format then adds a space
        'to separate them frm each other
        If LenLetter <= 99 Then encstr$ = encstr & "0" & _
          Asc(Letter) + Math & " "
    Next i


    'This is part of what i'm doing to convert the encrypted
    'numbers to Letters so it sort of encrypts the
    'encrypted message.
    temp$ = encstr 'hold the encrypted data
    temp$ = TrimSpaces(temp) 'get rid of the spaces
    itempnum% = Mid(temp, 1, 2) 'grab the first 2 numbers
    temp2$ = Chr(itempnum% + 100) 'Now add 100 so it
                                   'will be a valid char

    'If its a 2 digit number hold it and continue
    If Len(itempnum%) >= 2 Then itempstr$ = Str(itempnum%)
 
   'If the number is a single digit then add a '0' to the front
   'then hold it
    If Len(itempnum%) = 1 Then itempstr$ = "0" & _
        TrimSpaces(Str(itempnum%))
    
    encrypted2$ = temp2 'set the encrypted message
    
    For i = 3 To Len(temp) Step 2
        itempnum% = Mid(temp, i, 2) 'grab the next 2 numbers
  
      ' add 100 so it will be a valid char
        temp2$ = Chr(itempnum% + 100)

      'if its the last number we only want to hold it we
       'don't want to add a '0' even if its a single digit
        If i = Len(temp) Then itempstr$ = _
         Str(itempnum%): GoTo itsdone

'If its a 2 digit number hold it and continue
        If Len(itempnum%) = 2 Then itempstr$ = _
            Str(itempnum%)

        'If the number is a single digit then add a '0'
        'to the front then hold it
        If Len(TrimSpaces(Str(itempnum))) = 1 Then _
      itempstr$ = "0" & TrimSpaces(Str(itempnum%))

        'Now check to see if a - number was created
        'if so cause an error message
        If Left(TrimSpaces(Str(itempnum)), 1) = "-" Then _
          Err.Raise 20000, , "Unexpected Error"
           

itsdone:
           'Set The Encrypted message
        encrypted2$ = encrypted2 & temp2$
    Next i


    'Encrypt = encstr 'Returns the First Encrypted String
    Encrypt = encrypted2 'Returns the Second Encrypted String
    Exit Function 'We are outta Here
oops:
    Debug.Print "Error description", Err.Description
    Debug.Print "Error source:", Err.Source
    Debug.Print "Error Number:", Err.Number
End Function

[aseel20006]

Public Function Decrypt(ByVal Encrypted As String, _
    sEncKey As String) As String

    Dim NewEncrypted As String
    Dim Letter As String
    Dim KeyNum As String
    Dim EncNum As String
    Dim encbuffer As Long
    Dim strDecrypted As String
    Dim Kdecrypt As String
    Dim lastTemp As String
    Dim LenTemp As Integer
    Dim temp As String
    Dim temp2 As String
    Dim itempstr As String
    Dim itempnum As Integer
    Dim Math As Long
    Dim i As Integer
    
    On Error GoTo oops

    If sEncKey = "" Then sEncKey = "WhiteKnight"

    ReDim encKEY(1 To Len(sEncKey))
    
    'Convert The Key For Decryption
    For i = 1 To Len(sEncKey$)
        KeyNum = Mid$(sEncKey$, i, 1) 'Get Letter i% in the Key
        encKEY(i) = Asc(KeyNum) 'Convert Letter i to Asc value
 
'if it the first letter just hold it
       If i = 1 Then Math = encKEY(i): GoTo nextone
       If i >= 2 And Math - encKEY(i) >= 0 And encKEY(i) _
               <= encKEY(i - 1) Then Math = Math - encKEY(i)
               'compares the value to the previous value and
               'then either adds/subtracts the value to the
               'Math total
        If i >= 2 And Math - encKEY(i) >= 0 And encKEY(i) _
              <= encKEY(i - 1) Then Math = Math - encKEY(i)
        If i >= 2 And encKEY(i) >= Math And encKEY(i) _
              >= encKEY(i - 1) Then Math = Math + encKEY(i)
        If i >= 2 And encKEY(i) < Math And encKEY(i) _
              >= encKEY(i - 1) Then Math = Math + encKEY(i)
nextone:
    Next i
    
    
    'This is part of what i'm doing to convert the encrypted
    'numbers to  Letters so it sort of encrypts the encrypted
    'message.
    temp$ = Encrypted 'hold the encrypted data


    For i = 1 To Len(temp)
        itempstr = TrimSpaces(Str(Asc(Mid(temp, i, 1)) - _
           100)) 'grab the next 2 numbers
           'If its a 2 digit number hold it and continue
        If Len(itempstr$) = 2 Then itempstr$ = itempstr$
          If i = Len(temp) - 2 Then LenTemp% = _
               Len(Mid(temp2, Len(temp2) - 3))
          If i = Len(temp) Then itempstr$ = _
              TrimSpaces(itempstr$): GoTo itsdone
          'If the number is a single digit then add a '0' to the
          'front then hold it
        If Len(TrimSpaces(itempstr$)) = 1 Then _
             itempstr$ = "0" & TrimSpaces(itempstr$)
        'Now check to see if a - number was created if so
        'cause an error message
        If Left(TrimSpaces(itempstr$), 1) = "-" Then _
             Err.Raise 20000, , "Unexpected Error"
           

itsdone:
        temp2$ = temp2$ & itempstr 'hold the first decryption
    Next i
    
    
    Encrypted = TrimSpaces(temp2$) 'set the encrypted data


    For i = 1 To Len(Encrypted) Step 3
        'Format the encrypted string for the second decryption
        NewEncrypted = NewEncrypted & _
            Mid(Encrypted, CLng(i), 3) & " "
    Next i

' Hold the last set of numbers to check it its the correct format
    lastTemp$ = TrimSpaces(Mid(NewEncrypted, _
         Len(NewEncrypted$) - 3))
         
         If Len(lastTemp$) = 2 Then
' If it = 2 then its not the Correct format and we need to fix it
        lastTemp$ = Mid(NewEncrypted, _
           Len(NewEncrypted$) - 1) 'Holds Last Number so a '0'
                                    'Can be added between them
'set it to the new format
        Encrypted = Mid(NewEncrypted, 1, _
           Len(NewEncrypted) - 2) & "0" & lastTemp$
Else
        Encrypted$ = NewEncrypted$ 'set the new format

    End If
    'The Actual Decryption
    For i = 1 To Len(Encrypted)
        Letter = Mid$(Encrypted, i, 1) 'Hold Letter at index i
        EncNum = EncNum & Letter 'Hold the letters
        If Letter = " " Then 'we have a letter to decrypt
            encbuffer = CLng(Mid(EncNum, 1, _
              Len(EncNum) - 1)) 'Convert it to long and
                                 'get the number minus the " "
            strDecrypted$ = strDecrypted & Chr(encbuffer - _
               Math) 'Store the decrypted string
            EncNum = "" 'clear if it is a space so we can get
                        'the next set of numbers
        End If
    Next i

    Decrypt = strDecrypted

    Exit Function
oops:
    Debug.Print "Error description", Err.Description
    Debug.Print "Error source:", Err.Source
    Debug.Print "Error Number:", Err.Number
Err.Raise 20001, , "You have entered the wrong encryption string"

End Function

Private Function TrimSpaces(strstring As String) As String
    Dim lngpos As Long
    Do While InStr(1&, strstring$, " ")
        DoEvents
         lngpos& = InStr(1&, strstring$, " ")
         strstring$ = Left$(strstring$, (lngpos& - 1&)) & _
            Right$(strstring$, Len(strstring$) - _
               (lngpos& + Len(" ") - 1&))
    Loop
     TrimSpaces$ = strstring$
End Function

[aseel20006]

form1

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form Form1 
   Caption         =   "Privacy"
   ClientHeight    =   6630
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6600
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6630
   ScaleWidth      =   6600
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton CmdSave 
      Caption         =   "Savefile"
      Height          =   255
      Left            =   3600
      TabIndex        =   6
      Top             =   480
      Width           =   1215
   End
   Begin MSComDlg.CommonDialog CmDlg 
      Left            =   5640
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdLoad 
      Caption         =   "Loadfile"
      Height          =   255
      Left            =   2280
      TabIndex        =   5
      Top             =   480
      Width           =   1215
   End
   Begin VB.CommandButton CmdDecrypt 
      Caption         =   "Decrypt"
      Height          =   255
      Left            =   3600
      TabIndex        =   3
      Top             =   120
      Width           =   1215
   End
   Begin VB.TextBox TxtPassword 
      Height          =   285
      IMEMode         =   3  'DISABLE
      Left            =   960
      PasswordChar    =   "*"
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin VB.CommandButton CmdEncrypt 
      Caption         =   "Encrypt"
      Height          =   255
      Left            =   2280
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
   Begin RichTextLib.RichTextBox Rich1 
      Height          =   5535
      Left            =   173
      TabIndex        =   2
      Top             =   840
      Width           =   6255
      _ExtentX        =   11033
      _ExtentY        =   9763
      _Version        =   393217
      BorderStyle     =   0
      ScrollBars      =   3
      TextRTF         =   $"Form1.frx":0442
   End
   Begin VB.Label Label2 
      Caption         =   "Arbejder vent venligst"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   840
      Left            =   1860
      TabIndex        =   7
      Top             =   3015
      Width           =   3255
   End
   Begin VB.Label Label1 
      Caption         =   "Password:"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'
'This is just a simple encryption program, if you're a beginnger this can help you understand
'
'Encryption program all this happen width the module ModEncDec and Microsoft Scripting Runtime
'
'Made by Peder Larsen 'May 2001
'
Dim Fso As New FileSystemObject
Dim Ts As TextStream
Private Sub CmdEncrypt_Click()
    Form1.Enabled = False 'Disable form so you can't click in it while it's working
    Rich1.Visible = False 'Making richtextbox invisible so you can see program is working
    Rich1.Text = Encrypt(Rich1.Text, TxtPassword.Text) 'Encrypt text in richbox
    Rich1.Visible = True 'Richtextbox visible again
    Form1.Enabled = True 'Enables form again
End Sub

Private Sub CmdDecrypt_Click()
    Form1.Enabled = False 'Disable form so you can't click in it while it's working
    Rich1.Visible = False 'Making richtextbox invisible so you can see program is working
    Rich1.Text = Decrypt(Rich1.Text, TxtPassword.Text) 'Decrypt text in richbox
    Rich1.Visible = True 'Richtextbox visible again
    Form1.Enabled = True 'Enables form again
End Sub

Private Sub CmdLoad_Click()
On Error GoTo end1 'If something goes wrong jump to end1 such as cancel
    CmDlg.ShowOpen 'Shows openfile dialogbox
    Rich1.Text = "" 'Empty the richtextbox
    Set Ts = Fso.OpenTextFile(CmDlg.FileName, ForReading) 'Gets ready for loading file with textstream object
    Rich1.Text = Ts.ReadAll 'Loading all from textfile and puts it info richtextbox
    Ts.Close 'Closing for textstream
    Form1.Caption = "Privacy - " & CmDlg.FileName 'Setting caption in form1 vidth filename
end1:
End Sub

Private Sub CmdSave_Click()
On Error GoTo end1 'If something goes wrong jump to end1 such as cancel
    CmDlg.ShowSave 'Shows savefile dialogbox
    Set Ts = Fso.CreateTextFile(CmDlg.FileName, True) 'Gets ready for saveing file with textstream object
    Ts.Write Rich1.Text 'Takes all text and save it into file
    Ts.Close 'Closing for textstream
    Load Form2 'Opening form2, so you can see that saved file also can be decrypted
    Form2.Visible = True 'Making form2 visible
    Form1.Caption = "Privacy - " & CmDlg.FileName 'Setting caption in form1 vidth new filename
end1:
End Sub






form2

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form Form2 
   Caption         =   "Test"
   ClientHeight    =   6180
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6510
   LinkTopic       =   "Form2"
   ScaleHeight     =   6180
   ScaleWidth      =   6510
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton CmdClose 
      Caption         =   "&Close"
      Height          =   375
      Left            =   2708
      TabIndex        =   1
      Top             =   5760
      Width           =   1095
   End
   Begin RichTextLib.RichTextBox Rich1 
      Height          =   5535
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   6255
      _ExtentX        =   11033
      _ExtentY        =   9763
      _Version        =   393217
      BorderStyle     =   0
      ScrollBars      =   3
      TextRTF         =   $"Form2.frx":0000
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Fso As New FileSystemObject
Dim Ts As TextStream
Private Sub CmdClose_Click()
    Unload Form2 'Closes form2
End Sub

Private Sub Form_Load()
On Error GoTo end1
    Rich1.Text = "" 'Empty the richtextbox
    Set Ts = Fso.OpenTextFile(Form1.CmDlg.FileName, ForReading) 'Gets ready for loading file with textstream object
    Rich1.Text = Ts.ReadAll 'Loading all from textfile and puts it info richtextbox
    Ts.Close 'Closing for textstream
    Rich1.Text = Decrypt(Rich1.Text, Form1.TxtPassword.Text) 'Decrypting the text in richtextbox
    Form2.Caption = "Test of " & Form1.CmDlg.FileName 'Setting form2 caption to "test of filename"
end1:
End Sub

[si_the_geek]

l use vb8 and the encryption code is vb5 ... so how can l modify it to be applicable with vb8

VB7 (or VB2002) and later are VB.Net, which is very different to earlier versions of VB (known as "Classic VB)... they are basically different languages that happen to have VB in the name.

It is almost certainly better to start again (or find an example in the right language), as there are so many things that are done differently.