Encryption Algorithm

[SunBoy_]

سلامي به گرماي خورشيد ٬٬٬

دوستان شما چه روشي را براي Encrypt يك رشته پيشنهاد مي كنيد ؟؟

من به وسيله ASP يك cookie ايجاد كردم كه مي خواهم اطلاعات داخل آن Encrypt شده باشد ٬٬٬ حالا از چه روشي مي توانم اين كار را انجام دهم ؟

البته يك سري component گرفتم كه اين كار را براحتي انجام مي دهد ولي نمي خوام از component استفاده كنم


با آرزوي موفقيت و داشتن لحظات گرم ٬٬

 

[omidak]

سلام:
شما با AspClassic کار میکنید یا .Net ؟

 

[hoom]

با سلام

همانطور که میدونین Base64 یکی از بهترین روشهای کدگذاری است. در اینجا من کد دوتا تابع برای کدگذاری و رمزگشایی یک رشته به ASP گذاشتم

Function Base64Decode(ByVal base64String)
  'rfc1521
  '1999 Antonin Foller, PSTRUH Software, http://pstruh.cz
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim dataLength, sOut, groupBegin
  
  'remove white spaces, If any
  base64String = Replace(base64String, vbCrLf, "")
  base64String = Replace(base64String, vbTab, "")
  base64String = Replace(base64String, " ", "")
  
  'The source must consists from groups with Len of 4 chars
  dataLength = Len(base64String)
  If dataLength Mod 4 <> 0 Then
    Err.Raise 1, "Base64Decode", "Bad Base64 string."
    Exit Function
  End If

  
  ' Now decode each group:
  For groupBegin = 1 To dataLength Step 4
    Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
    ' Each data group encodes up To 3 actual bytes.
    numDataBytes = 3
    nGroup = 0

    For CharCounter = 0 To 3
      ' Convert each character into 6 bits of data, And add it To
      ' an integer For temporary storage.  If a character is a '=', there
      ' is one fewer data byte.  (There can only be a maximum of 2 '=' In
      ' the whole string.)

      thisChar = Mid(base64String, groupBegin + CharCounter, 1)

      If thisChar = "=" Then
        numDataBytes = numDataBytes - 1
        thisData = 0
      Else
        thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
      End If
      If thisData = -1 Then
        Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
        Exit Function
      End If

      nGroup = 64 * nGroup + thisData
    Next
    
    'Hex splits the long To 6 groups with 4 bits
    nGroup = Hex(nGroup)
    
    'Add leading zeros
    nGroup = String(6 - Len(nGroup), "0") & nGroup
    
    'Convert the 3 byte hex integer (6 chars) To 3 characters
    pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
      Chr(CByte("&H" & Mid(nGroup, 5, 2)))
    
    'add numDataBytes characters To out string
    sOut = sOut & Left(pOut, numDataBytes)
  Next

  Base64Decode = sOut
End Function


%>

و اینم بعدی

Function Base64Encode(inData)
  'rfc1521
  '2001 Antonin Foller, PSTRUH Software, http://pstruh.cz
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim cOut, sOut, I
  
  'For each group of 3 bytes
  For I = 1 To Len(inData) Step 3
    Dim nGroup, pOut, sGroup
    
    'Create one long from this 3 bytes.
    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
      &H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
    
    'Oct splits the long To 8 groups with 3 bits
    nGroup = Oct(nGroup)
    
    'Add leading zeros
    nGroup = String(8 - Len(nGroup), "0") & nGroup
    
    'Convert To base64
    pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
    
    'Add the part To OutPut string
    sOut = sOut + pOut
    
    'Add a new line For Each 76 chars In dest (76*3/4 = 57)
    'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
  Next
  Select Case Len(inData) Mod 3
    Case 1: '8 bit final
      sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2: '16 bit final
      sOut = Left(sOut, Len(sOut) - 1) + "="
  End Select
  Base64Encode = sOut
End Function

Function MyASC(OneChar)
  If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function

توضیحات نویسنده هم برای رعایت کپی رایت توی برنامه هستش
اینم یه نمونه برای چگونگی استفاده از آن

<%
Dim UID, PWD
GetUser UID, PWD
If UID = "" Then
'or If Not HasAccess(UID, PWD) Then
  Response.Status = "401 Access Denied"
  Response.Write "Some page with info about user names And registration"
End If

Sub GetUser(LOGON_USER, LOGON_PASSWORD)
  Dim UP, Pos, Auth
  Auth = Request.ServerVariables("HTTP_AUTHORIZATION")
  LOGON_USER = ""
  LOGON_PASSWORD = ""
  If LCase(Left(Auth, 5)) = "basic" Then
    UP = Base64Decode(Mid(Auth, 7))
    Pos = InStr(UP, ":")
    If Pos > 1 Then
      LOGON_USER = Left(UP, Pos - 1)
      LOGON_PASSWORD = Mid(UP, Pos + 1)
    End If
  End If
End Sub

ارادتمند

 

[SunBoy_]

من با ASPClassic كار مي كنم ٬٬

جناب hoom مرسي از راهنماييت ٬ base64 رو تست كردم و جواب هم گرفتم ٬