توابع API در Vb.Net

[casedl]

سلام..
کسی میتونه کد چند تا تابع api رو برای من تبدیل کنه به vb.net ؟
خودم کد ویژوال بیسیک 6 رو دارم و میخوام که تبدیل بشه به vb.net که ارور نده ! :گریه:

تابع FindExecutable :
این برنامه یک تکست باکس هم روی فرم داره !


Private Const MAX_FILENAME_LEN = 260

Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long

Private Sub Form_Load()
Dim p As Integer, Buf As String

pFile = "C:\Hossein.txt"
If Dir(pFile) = "" Or pFile = "" Then 'pFile>>>The file NO Hiddein
Text1.Text = "File not found!"
Exit Sub
End If

Buf = String(MAX_FILENAME_LEN, 32)
p = FindExecutable(pFile, vbNullString, Buf) 'pFile>>>The file All (hiddein ana Nohidden)
If p > 32 Then
Text1.Text = Left$(Buf, InStr(Buf, Chr$(0)) - 1)
Else
Text1.Text = "No EXEC File"
End If
End Sub

ممنون

[gilsoft]

میخوام که تبدیل بشه به vb.net که ارور نده ! :گریه:

سلام دوست عزیز

از کد زیر استفاده کن :

Public Declare Auto Function FindExecutable Lib "shell32.dll" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Int32

موفق باشید

[casedl]

سلام.
به این قسمت گیر میده و میگه Invalid Base



Buf = Convert.ToString(MAX_FILENAME_LEN, 32)

[gilsoft]

سلام.
به این قسمت گیر میده و میگه Invalid Base
Buf = Convert.ToString(MAX_FILENAME_LEN, 32)

سلام دوست عزیز

کد شما رو به شکل زیر تصحیح کردم .. کار هم میکنه

Imports VB = Microsoft.VisualBasic

Public Class Form1

Private Const MAX_FILENAME_LEN = 260

Public Declare Auto Function FindExecutable Lib "shell32.dll" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Int32

Private Sub Form_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Dim p As Integer
Dim pFile As String = "C:\Hossein.txt"
If Dir(pFile) = "" Or pFile = "" Then
Text1.Text = "File not found!"
Exit Sub
End If
Dim Buf As New String(" "c, MAX_FILENAME_LEN)
p = FindExecutable(pFile, vbNullString, Buf)
If p > 32 Then
Text1.Text = VB.Left(Buf, InStr(Buf, Chr(0)) - 1)
Else
Text1.Text = "No EXEC File"
End If
End Sub
End Class


موفق باشید

[casedl]

سلام . ممنون از زحمتتون ! الهی هر چی از خدا میخوای بهت بده .

لطفا این دو تابع دیگه رو هم برام تبدیل کنید . ممنون میشم

تابع GetCommandLine :


Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

Private Sub Form_Load()
Dim Retval As Long, Buffer As String

Buffer = String(512, 0)
Retval = GetCommandLine
CopyMemory Buffer, Retval, Len(Retval)
Text1.Text = Buffer
End Sub


تابع ShellExecuteEx :



Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_FLAG_NO_UI = &H400

Private Const SW_HIDE = 0
Private Const SW_MAX = 10
Private Const SW_MAXIMIZE = 3
Private Const SW_MINIMIZE = 6
Private Const SW_NORMAL = 1
Private Const SW_RESTORE = 9
Private Const SW_SHOW = 5
Private Const SW_SHOWDEFAULT = 10
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOWNORMAL = 1

Private Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type

Private Declare Function ShellExecuteEx Lib "shell32.dll" (SEI As SHELLEXECUTEINFO) As Long

Private Sub Form_Load()
Dim SEI As SHELLEXECUTEINFO

With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = Me.hwnd
.lpVerb = "Properties" ' "Open" "Delete" "Cut" "Print" and ....
.lpFile = "c:\Autoexec.bat" ' "notepad.exe"
.lpParameters = vbNullString
.lpDirectory = vbNullString
.nShow = 0 '0 >> 1
End With
ShellExecuteEx SEI
End Sub

[gilsoft]

سلام دوست عزیز

اگه روی "تشکر کردن" یه کلیک میکردی .. خیلی خوب میشد :افسرده:

Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As String
Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByVal hpvDest As Object, ByVal hpvSource As Object, ByVal cbCopy As Integer)

Private Sub API1()
Dim Retval As Long, Buffer As String
Buffer = New String(" "c, 512)
Retval = GetCommandLine
CopyMemory(Buffer, Retval, Len(Retval))
Text1.Text = Buffer
End Sub

دومی هم برات تصحیح میکنم و تا دقایقی دیگر میزارم همینجا

موفق باشید

[gilsoft]

اینم دومی

اون مثالی که شما گذاشتید برای Windows CE و ... هستش

اما این کد کار میکنه :

Option Explicit On

Public Class Form2

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Const SW_SHOWNORMAL = 1

Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&

Function StartDoc(DocName As String) As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
StartDoc = ShellExecute(Scr_hDC, "Open", DocName, "", "C:\", SW_SHOWNORMAL)
End Function 'StartDoc()

Private Sub Form_Click()
Dim r As Long, msg As String
r = StartDoc("C:\WINDOWS\ARCADE.BMP")
If r <= 32 Then
'There was an error
Select Case r
Case SE_ERR_FNF
msg = "File not found"
Case SE_ERR_PNF
msg = "Path not found"
Case SE_ERR_ACCESSDENIED
msg = "Access denied"
Case SE_ERR_OOM
msg = "Out of memory"
Case SE_ERR_DLLNOTFOUND
msg = "DLL not found"
Case SE_ERR_SHARE
msg = "A sharing violation occurred"
Case SE_ERR_ASSOCINCOMPLETE
msg = "Incomplete or invalid file association"
Case SE_ERR_DDETIMEOUT
msg = "DDE Time out"
Case SE_ERR_DDEFAIL
msg = "DDE transaction failed"
Case SE_ERR_DDEBUSY
msg = "DDE busy"
Case SE_ERR_NOASSOC
msg = "No association for file extension"
Case ERROR_BAD_FORMAT
msg = "Invalid EXE file or error in EXE image"
Case Else
msg = "Unknown error"
End Select
MsgBox(msg)
End If
End Sub
End Class

کلیک روی "تشکر کردن" یادت نره :چشمک:
موفق باشید

[casedl]

سلام..

از کلید تشکر استفاده کردم . ممنون

لطفا زحمت این سه تابع رو هم بکشید :

تابع EnumChildWindows :

Private Sub Form_Load()
List1.Clear

EnumChildWindows GetDesktopWindow, AddressOf EnumChildProc, ByVal 0&
End Sub

Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long


Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim Buffer As String
Dim lenCaption As Long

lenCaption = GetWindowTextLength(hwnd)
Buffer = Space$(lenCaption + 1)
GetWindowText hwnd, Buffer, Len(Buffer)
Buffer = Left$(Buffer, Len(Buffer) - 1)
If Buffer <> "" Then Form1.List1.AddItem Buffer
EnumChildProc = True
End Function


تابع EnumWindows :


Public Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim Buf As String, Retval As Long

Retval = GetWindowTextLength(hwnd)
Buf = Space(Retval)
GetWindowText hwnd, Buf, Retval + 1
Form1.List1.AddItem Str$(hwnd) + " " + Buf

EnumWindowsProc = True
End Function

Private Sub Form_Load()
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
End Sub



تابع Get VersionEx :


Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Sub Form_Load()
Dim Info As OSVERSIONINFO, strOs As String
Dim Retval As Long, Result As String

Me.AutoRedraw = True
Info.dwOSVersionInfoSize = Len(Info)
Retval = GetVersionEx(Info)
If Retval = 0 Then MsgBox "Error": Exit Sub
Select Case Info.dwPlatformId
Case 0
strOs = "Windows 3.x"
Case 1
If (Info.dwMinorVersion = 0) Then
strOs = "Windows 95"
End If
If (Info.dwMinorVersion = 10) Then
strOs = "Windows 98"
End If
If (Info.dwMinorVersion = 90) Then
strOs = "Windows ME"
End If
Case 2
If (Info.dwMajorVersion < 5) Then
strOs = "Windows NT"
End If
If (Info.dwMajorVersion = 5 And Info.dwMinorVersion = 0) Then
strOs = "Windows 2K"
End If
If (Info.dwMajorVersion = 5 And Info.dwMinorVersion = 1) Then
strOs = "Windows XP"
End If
End Select
Text1.Text = strOs
Result = Str$(Info.dwMajorVersion) + "." + LTrim(Str(Info.dwMinorVersion))
Text2.Text = Result
End Sub