من یه کد ویبی 6 دارم که باهاش میشه اطلاعات درمورد کانکشن های ویندوز به دست آورد . مثل UserName . میخوام تبدیلش کنم به
ویبی دات نت و ازش توی پروژه دات نتم استفاده کنم ولی نمیدونم چه جوری .کمکم کنید .
کد ویبی 6 به صورت زیر هستش :
ابتدا یه لیست ویو توی فرم بزارید .
بعد کد زیر رو به فرمتون اضافه کنید :
حالا یه ماژولبا نام Ras.bas ایجاد و کد زیر رو توش کپی کنید :کد: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
یه سوال دیگه هم دارم.کد:'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
ما یه پیکچر باکس رو فرم داریم که یه عکس توشه . چه طور میشه فقط یه قسمت از عکس توش رو به داخل یه پیکچر باکس دیگه فرستاد .
Bookmarks