سوال: كمك - استفاده از DLL در PHP [بایگانی]

allaf2

شنبه 20 تیر 1388, 00:03 صبح

سلام

من يك سورس ويژال بيسك دارم كه ميخوام به PHP تبديل كنم
در اين سورس از چند فايل DLL استفاده شده.
سوال من اينه كه آيا ميشه در PHP هم از فايلهاي DLL استفاده كرد؟

كد زير مد نظر من هست

Option Explicit
Public Event InvalidLogin()
Public Event RecvToken(ByVal Y_CookiePart As String, ByVal T_CookiePart As String, ByVal B_CookiePart As String, ByVal LoginHash As String)
Public Event SckError(ByVal ErrorNum As Long, ByVal ErrorDesc As String)
Private WithEvents YSocketLayer1 As WinHttp.WinHttpRequest
Private WithEvents YSocketLayer2 As WinHttp.WinHttpRequest
Private Declare Function CryptBinaryToString Lib "crypt32.dll" Alias "CryptBinaryToStringA" (ByRef pbBinary As Byte, ByVal cbBinary As Long, ByVal dwFlags As Long, ByVal pszString As String, ByRef pcchString As Long) As Long
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, pbData As Any, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private HttpBuffer As String, SecureHost As String, YmsgChallenge As String

Public Sub GetToken(YahooID As String, Password As String, YmChallenge As String, Optional HostName As String = "login.yahoo.com")
On Error Resume Next
SecureHost = HostName
YmsgChallenge = YmChallenge
Set YSocketLayer1 = New WinHttp.WinHttpRequest
YSocketLayer1.Option(WinHttpRequestOption_EnableHt tp1_1) = True
YSocketLayer1.Option(WinHttpRequestOption_EnableRe directs) = False
YSocketLayer1.Option(WinHttpRequestOption_SslError IgnoreFlags) = &H3300
YSocketLayer1.Open "GET", "https://" & SecureHost & "/config/pwtoken_get?src=ymsgr&ts=&login=" & YahooID & "&passwd=" & Password & "&chal=" & YmChallenge, True
YSocketLayer1.SetRequestHeader "Accept-Language", "en-us"
YSocketLayer1.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1)"
YSocketLayer1.SetRequestHeader "Accept", "*/*"
YSocketLayer1.Send
End Sub

Private Sub YSocketLayer1_OnResponseDataAvailable(Data() As Byte)
On Error Resume Next
HttpBuffer = HttpBuffer & StrConv(Data, vbUnicode)
End Sub

Private Sub YSocketLayer1_OnResponseFinished()
On Error Resume Next
Dim SplDat1() As String, SplDat2() As String
If InStr(1, HttpBuffer, "ymsgr=") Then
SplDat1 = Split(HttpBuffer, "ymsgr=")
SplDat2 = Split(SplDat1(1), vbCrLf)
Set YSocketLayer2 = New WinHttp.WinHttpRequest
YSocketLayer2.Option(WinHttpRequestOption_EnableHt tp1_1) = True
YSocketLayer2.Option(WinHttpRequestOption_EnableRe directs) = False
YSocketLayer2.Option(WinHttpRequestOption_SslError IgnoreFlags) = &H3300
YSocketLayer2.Open "GET", "https://" & SecureHost & "/config/pwtoken_login?src=ymsgr&ts=&token=" & SplDat2(0), True
YSocketLayer2.SetRequestHeader "Accept-Language", "en-us"
YSocketLayer2.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1)"
YSocketLayer2.SetRequestHeader "Accept", "*/*"
YSocketLayer2.Send
Else
RaiseEvent InvalidLogin
End If
HttpBuffer = ""
Set YSocketLayer1 = Nothing
End Sub

Private Sub YSocketLayer1_OnError(ByVal ErrorNumber As Long, ByVal ErrorDescription As String)
On Error Resume Next
RaiseEvent SckError(ErrorNumber, ErrorDescription)
End Sub

Private Sub YSocketLayer2_OnResponseDataAvailable(Data() As Byte)
On Error Resume Next
HttpBuffer = HttpBuffer & StrConv(Data, vbUnicode)
End Sub

Private Sub YSocketLayer2_OnResponseFinished()
On Error Resume Next
Dim SplDat1() As String, SplDat2() As String
Dim YCookie As String, TCookie As String, BCookie As String, YCrumb As String
If InStr(1, HttpBuffer, "crumb=") Then
SplDat1 = Split(HttpBuffer, "Y=")
SplDat2 = Split(SplDat1(1), ";")
YCookie = SplDat2(0) & "; path=/; domain=.yahoo.com"
SplDat1 = Split(HttpBuffer, "T=")
SplDat2 = Split(SplDat1(1), ";")
TCookie = SplDat2(0) & "; path=/; domain=.yahoo.com"
SplDat1 = Split(YSocketLayer2.GetAllResponseHeaders, "B=")
SplDat2 = Split(SplDat1(1), ";")
BCookie = "B" & Chr(9) & SplDat2(0)
SplDat1 = Split(HttpBuffer, "crumb=")
SplDat2 = Split(SplDat1(1), vbCrLf)
YCrumb = SplDat2(0)
RaiseEvent RecvToken(YCookie, TCookie, BCookie, Mac64(MD5(YCrumb & YmsgChallenge)))
End If
HttpBuffer = ""
Set YSocketLayer2 = Nothing
End Sub

Private Sub YSocketLayer2_OnError(ByVal ErrorNumber As Long, ByVal ErrorDescription As String)
On Error Resume Next
RaiseEvent SckError(ErrorNumber, ErrorDescription)
End Sub

Private Function MD5(ByVal StrText As String) As String
On Error Resume Next
Dim hProv As Long, phHash As Long, pdwDataLen As Long, pbData() As Byte
Call CryptAcquireContext(hProv, vbNullString, vbNullString, 1, &HF0000000)
Call CryptCreateHash(hProv, 32768 Or 0 Or 3, 0, 0, phHash)
Call CryptHashData(phHash, ByVal StrText, Len(StrText), 0)
Call CryptGetHashParam(phHash, 4, pdwDataLen, 4, 0)
ReDim pbData(0 To pdwDataLen - 1)
Call CryptGetHashParam(phHash, 2, pbData(0), pdwDataLen, 0)
MD5 = StrConv(pbData, vbUnicode)
CryptDestroyHash phHash
CryptReleaseContext hProv, 0
End Function

Private Function Mac64(ByVal StrText As String) As String
On Error Resume Next
Dim ReturnHash As String, ReturnHashLength As Long, pbData() As Byte, X As Integer
pbData = StrConv(StrText, vbFromUnicode)
Call CryptBinaryToString(pbData(0), UBound(pbData) + 1, 1, vbNullString, ReturnHashLength)
ReturnHash = String(ReturnHashLength, Chr(0))
Call CryptBinaryToString(pbData(0), UBound(pbData) + 1, 1, ReturnHash, ReturnHashLength)
ReturnHash = Replace(ReturnHash, Chr(43), Chr(46))
ReturnHash = Replace(ReturnHash, Chr(47), Chr(95))
ReturnHash = Replace(ReturnHash, Chr(61), Chr(45))
For X = ReturnHashLength To 1 Step -1
If Asc(Mid(ReturnHash, X, 1)) > 32 Then Exit For
Next
Mac64 = Left(ReturnHash, X)
End Functionاصلا اين كد رو ميشه به PHP ترجمه كرد ؟

ممنون

r0ot$harp

شنبه 20 تیر 1388, 18:09 عصر