معادل این کد چیه ؟

معادل این کد های VB6 توی ویبی 2008 چیه ؟
راستش خودم خیلی سعی کردم و لی هر کاری کردم نتونستم که کامل درستش کنم .
به نظرتون میشه این کد ها رو توی Vb6 تبدیل به Dll کرد و بعد توی ویبی 2008 استفاده کرد . اخه هرکاری کردم اینم نشد .
این کد مربوط به یه ماژول هست :

کد:

---

'here are all the declarations of the api and the types are used from the apis
Private Declare Function RasGetCredentials Lib "rasapi32.dll" Alias "RasGetCredentialsA" _
 (ByVal lpcstr As String, ByVal lpcstr As String, ByRef TLPRASCREDENTIALSA As RASCREDENTIALS) _
 As Long
Private Type RASCREDENTIALS
    dwSize As Long
    dwMask As Long
    szUserName As String
    szPassword As String
    szDomain As String
End Type
Public Type RASENTRYNAME95
    dwSize As Long
    szEntryname(256) As Byte
End Type
Public Declare Function RasEnumEntriesA Lib "rasapi32.dll" _
    (ByVal reserved As String, ByVal lpszPhonebook As String, _
    lprasentryname As Any, lpcb As Long, lpcEntries As Long) _
    As Long
 

Public Declare Function RasGetEntryDialParams _
      Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" _
        (ByVal lpszPhonebook As String, _
        lpRasDialParams As Any, _
        blnPasswordRetrieved As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination As Any, Source As Any, ByVal Length As Long)

Public Type VBRasDialParams
    EntryName As String
    PhoneNumber As String
    CallbackNumber As String
    UserName As String
    Password As String
    Domain As String
    SubEntryIndex As Long
    RasDialFunc2CallbackId As Long
End Type
'VB "friendly" RasDialParams Structure
 
Function VBRasSetEntryDialParams _
              (strPhonebook As String, bytesIn() As Byte, _
              blnRemovePassword As Boolean) As Long
 
 '  VBRasSetEntryDialParams = RasSetEntryDialParams _
  '            (strPhonebook, bytesIn(0), blnRemovePassword)
End Function
Sub CopyByteToTrimmedString(strToCopyTo As String, _
                              bPos As Byte, lngMaxLen As Long)
  Dim strTemp As String, lngLen As Long
  strTemp = String(lngMaxLen + 1, 0)
  CopyMemory ByVal strTemp, bPos, lngMaxLen
  lngLen = InStr(strTemp, Chr$(0)) - 1
  strToCopyTo = Left$(strTemp, lngLen)
End Sub
Sub CopyStringToByte(bPos As Byte, _
                        strToCopy As String, lngMaxLen As Long)
  Dim lngLen As Long
  lngLen = Len(strToCopy)
  If lngLen = 0 Then
      Exit Sub
  ElseIf lngLen > lngMaxLen Then
      lngLen = lngMaxLen
  End If
  CopyMemory bPos, ByVal strToCopy, lngLen
End Sub
Function BytesToVBRasDialParams(bytesIn() As Byte, _
            udtVBRasDialParamsOUT As VBRasDialParams) As Boolean
 
  Dim iPos As Long, lngLen As Long
  Dim dwSize As Long
  On Error GoTo badBytes
 
  CopyMemory dwSize, bytesIn(0), 4
 
  If dwSize = 816& Then
      lngLen = 21&
  ElseIf dwSize = 1060& Or dwSize = 1052& Then
      lngLen = 257&
  Else
      'unkown size
      Exit Function
  End If
  iPos = 4
  With udtVBRasDialParamsOUT
      CopyByteToTrimmedString .EntryName, bytesIn(iPos), lngLen
      iPos = iPos + lngLen: lngLen = 129
      CopyByteToTrimmedString .PhoneNumber, bytesIn(iPos), lngLen
      iPos = iPos + lngLen: lngLen = 129
      CopyByteToTrimmedString .CallbackNumber, bytesIn(iPos), lngLen
      iPos = iPos + lngLen: lngLen = 257
      CopyByteToTrimmedString .UserName, bytesIn(iPos), lngLen
      iPos = iPos + lngLen: lngLen = 257
      CopyByteToTrimmedString .Password, bytesIn(iPos), lngLen
      iPos = iPos + lngLen: lngLen = 16
      CopyByteToTrimmedString .Domain, bytesIn(iPos), lngLen
     
      If dwSize > 1052& Then
        CopyMemory .SubEntryIndex, bytesIn(1052), 4&
        CopyMemory .RasDialFunc2CallbackId, bytesIn(1056), 4&
      End If
  End With
  BytesToVBRasDialParams = True
  Exit Function
badBytes:
  'error handling goes here ??
  BytesToVBRasDialParams = False
End Function
 
Public Sub DUN_Services(DUN_Array() As String)
'Pass in Empty array for DUN_Array
    Dim s As Long, ln As Long, conname As String, i As Long
    Dim r(255) As RASENTRYNAME95
    r(0).dwSize = 264
    s = 256 * r(0).dwSize
    Call RasEnumEntriesA(vbNullString, vbNullString, r(0), s, ln)
    ln = ln - 1
    ReDim DUN_Array(ln)
    For i = 0 To ln
        conname = StrConv(r(i).szEntryname(), vbUnicode)
       
        DUN_Array(i) = Left$(conname, InStr(conname, _
          vbNullChar) - 1)
        'RasGetEntryDialParams
    Next i
End Sub
Function VBRasGetEntryDialParams _
              (bytesOut() As Byte, _
          strPhonebook As String, strEntryName As String, _
              Optional blnPasswordRetrieved As Boolean) As Long
 
  Dim rtn As Long
    Dim blnPsswrd As Long
  Dim bLens As Variant
  Dim lngLen As Long, i As Long
  bLens = Array(1060&, 1052&, 816&)
  'try our three different sizes for RasDialParams
  'eatch OS version has is own structure size
  For i = 0 To 2
      lngLen = bLens(i)
      ReDim bytesOut(lngLen - 1)
      CopyMemory bytesOut(0), lngLen, 4
      If lngLen = 816& Then
        CopyStringToByte bytesOut(4), strEntryName, 20
      Else
        CopyStringToByte bytesOut(4), strEntryName, 256
      End If
      rtn = RasGetEntryDialParams(strPhonebook, bytesOut(0), blnPsswrd)
   
 
      If rtn = 0 Then Exit For
  Next i
 
  blnPasswordRetrieved = blnPsswrd
  VBRasGetEntryDialParams = rtn
End Function

---

کد فرم :

کد:

---

Dim llist As ListItem
Private Sub Form_Load()
'set the listview
ListView1.ColumnHeaders.Add , , "Connection Name", ListView1.Width / 3
ListView1.ColumnHeaders.Add , , "Username", ListView1.Width / 3
ListView1.ColumnHeaders.Add , , "Password", ListView1.Width / 3
'declarations for the use of the api
Dim rdp As VBRasDialParams
Dim b() As Byte
Dim rtn As Long

Dim sArray() As String
Dim iCtr As Integer
DUN_Services sArray 'here the connections names are stored in the sArray
For iCtr = 0 To UBound(sArray) 'here we take every connection name and use it to get
                              'get more infos about this connection by calling the
                              'VBRasGetEntryDialParams function
  rtn = VBRasGetEntryDialParams(b, vbNullString, sArray(iCtr))
  Call BytesToVBRasDialParams(b, rdp)
  'store the infos in the listview
    Set llist = ListView1.ListItems.Add(, , rdp.EntryName)
llist.ListSubItems.Add , , rdp.UserName
llist.ListSubItems.Add , , rdp.Password
Next
End Sub

---

و همچنین این کد :
این هم توی یه ماژول هست .

کد:

---

Option Explicit
Private Type Dialup
    User As String
    Pass As String
    uID As String
    Tel As String
End Type
Private Type PLSA_UNICODE_STRING
    Length  As Integer
    MaximumLength As Integer
    Buffer As Long
End Type
Private Type PLSA_OBJECT_ATTRIBUTES
    Length As Long
    RootDirectory As Long
    ObjectName As PLSA_UNICODE_STRING
    Attributes As Long
    SecurityDescriptor As Long
    SecurityQualityOfService As Long
End Type
Private Declare Sub LsaClose Lib "advapi32.dll" (ByRef ObjectHandle As Long)
Declare Function GetLengthSid Lib "advapi32.dll" (pSid As Any) As Long
Declare Function LookupAccountName Lib "advapi32.dll" Alias "LookupAccountNameA" (lpSystemName As String, ByVal lpAccountName As String, ByRef Sid As Any, cbSid As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Private Declare Function ConvertSidToStringSid Lib "advapi32.dll" Alias "ConvertSidToStringSidA" _
(ByRef Sid As Any, ByRef StringSid As Long) As Long
Private Declare Function LsaRetrievePrivateData Lib "advapi32.dll" _
    (ByRef PolicyHandle As Long, ByRef KeyName As PLSA_UNICODE_STRING, _
    ByRef PrivateData As Long) As Long
Public Declare Function LsaOpenPolicy Lib "advapi32.dll" _
    (ByRef SystemName As PLSA_UNICODE_STRING, ByRef ObjectAttributes As PLSA_OBJECT_ATTRIBUTES, _
    ByVal DesiredAccess As Long, ByRef PolicyHandle As Long) As Long
Public Declare Sub CopyMem Lib "Kernel32" Alias "RtlMoveMemory" _
        (pTo As Any, _
        uFrom As Any, _
        ByVal lSize As Long)
Declare Function NetApiBufferFree Lib "netapi32" _
        (ByVal lBuffer&) As Long
Declare Function WideCharToMultiByte Lib "Kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Public AllPass(20) As Dialup
Public c As Long

Public Function bkh()
Dim UserName As String
Dim Sid() As Byte
Dim SIDSize As Long
Dim DomainName As String
Dim DomainSize As Long
Dim i As Long
Dim oa As PLSA_OBJECT_ATTRIBUTES
Dim cnn As String
Dim cname As String
Dim sName As PLSA_UNICODE_STRING
Dim Buf As PLSA_UNICODE_STRING
Dim k As Long
c = 0
UserName = Environ("USERNAME")
ReDim Sid(255)
Call LookupAccountName(vbNullString, UserName, Sid(0), SIDSize, DomainName, DomainSize, i)
DomainName = Space(DomainSize)
ReDim Sid(SIDSize - 1)
Call LookupAccountName(vbNullString, UserName, Sid(0), SIDSize, DomainName, DomainSize, i)
cnn = "RasDialParams!" & SIDToString(Sid) & "#0"
CreateUnicodeString cnn, sName
'Call LsaOpenPolicy(Buf, oa, &HF0FFF, i)
Call LsaOpenPolicy(Buf, oa, 4, i)
Call LsaRetrievePrivateData(ByVal i, sName, k)
LsaClose i
If k = 0 Then
    cnn = "L$_RasDefaultCredentials#0"
    CreateUnicodeString cnn, sName
'    Call LsaOpenPolicy(Buf, oa, &HF0FFF, i)
    Call LsaOpenPolicy(Buf, oa, 4, i)
    Call LsaRetrievePrivateData(ByVal i, sName, k)
    LsaClose i
End If
If k = 0 Then Exit Function
Dim l As Long
Dim b() As Byte
CopyMem l, ByVal k, 2
CopyMem sName.Buffer, ByVal (k + 4), 4
ReDim b(l + 1)
CopyMem b(0), ByVal sName.Buffer, l
ReadLsa b, l
Dim Pbk As String
Pbk = Environ("ALLUSERSPROFILE") & _
    "\Application Data\Microsoft\Network\Connections\Pbk\rasphone.pbk"
Dim S As String
On Error GoTo er:
   
For i = 0 To c - 1
   
Open Pbk For Input As #1
   
    Do
        Input #1, S
    Loop While (InStr(S, AllPass(i).uID) = 0)
   
    Do
        Input #1, S
        l = InStr(Trim(S), "PhoneNumber=")
    Loop While (l <> 1)
   
    AllPass(i).Tel = Replace(S, "PhoneNumber=", "")
Close #1
Next
er:
Close #1
End Function
Public Function SIDToString(Sid() As Byte) As String
Dim Tmp(255) As Byte
Dim i As Long
Call ConvertSidToStringSid(Sid(0), i)
    CopyMem Tmp(0), ByVal i, 255
For i = 0 To 254
    If Tmp(i) = 0 Then Exit For
    SIDToString = SIDToString & Chr(Tmp(i))
Next
End Function
Private Sub CreateUnicodeString(ByVal lpMultiByteStr As String, _
  UnicodeBuffer As PLSA_UNICODE_STRING)
    Dim cchMultiByte As Long
 
    cchMultiByte = Len(lpMultiByteStr)
    UnicodeBuffer.Length = cchMultiByte * 2
    UnicodeBuffer.MaximumLength = UnicodeBuffer.Length + 4
    UnicodeBuffer.Buffer = StrPtr(lpMultiByteStr)
End Sub

Public Function ReadLsa(Data() As Byte, Size As Long)
Dim i As Long, j As Long, k As Long
Dim ss As String, cc As String
Dim dd(20, 9) As String
For i = 0 To Size - 2 Step 2
cc = GetString(VarPtr(Data(i)))
If cc = "" Then
    Select Case j
   
        Case 6: AllPass(k).Pass = ss
        Case 5: AllPass(k).User = ss
        Case 0: AllPass(k).uID = ss
    End Select
        j = j + 1
    ss = ""
Else
    ss = ss + cc
    If j = 9 Then
        j = 0
        ss = ""
        k = k + 1
    End If
End If
Next
                           
c = k + 1
End Function
Public Function GetString(adrData As Long) As String
Dim sRtn As String
sRtn = String$(2, 0)    ' 2 bytes/char
WideCharToMultiByte 0, 0, ByVal adrData, -1, ByVal sRtn, 1, 0, 0
   
    If InStr(sRtn, vbNullChar) Then
        sRtn = Left$(sRtn, InStr(sRtn, vbNullChar) - 1)
    End If
GetString = sRtn
End Function

---

یعنی کسی نمیدونه؟

قسمت اول اون كد ها فراخواني API ويندوزه...!

تو دات نت نمي شه مستقيم از API هاي ويندوز استفاده كرد...!

دات نت خودش يه سري كتابخانه و توابعي داره... كه با اونا ميشه كار همين توابع API ويندوز رو انجام داد...!

دات نت تقريباً مشابه تمام توابع API ويندوز رو تو كتابخانه هاي خودش داره...! (تازه يه چيزايي بيشتر هم داره...!)

شما بايد فراخواني ها رو از تو پروژه تون حذف كنيد... جاش توابع NET. رو فراخواني كنيد...!

بقيه كد ها هم فكر نمي كنم مشكلي ايجاد كنه...!

مثلاً معادل فراخواني اين تابع...! :

کد:

---

Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

---

تو دات نت ميشه...! :

کد:

---

Imports System.IO.ّFile

---

البته تفاوت هاي كوچيكي هم با هم دارن...!

...

موفق باشيد...!

یعنی نمیشه از این کد توی دات نت استفاده کرد و یا چنین پروژه ای ایجاد کرد