اگه بخواید یک برنامه تقویت ویندوز بنویسید به گزینه خالی کردن سطل آشغال ویندوز نیاز خواهید داشت
سری قبل این اموزش رو در مورد کنترل سی پی یو (تاکس منیگر)ویندوز نوشتم
برای این کار باید از تابعی موجود در کتابخانه قدرتمند شل که در آرشیو اموزشهای زیادی راجع به این کتابخانه هست استفاده کنید
شیوه ی تعریف کتابخانه
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hWnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Const SHERB_NOPROGRESSUI = &H2
شیوه ی استفاده
Private Sub Command1_Click()
Dim retvaL
retvaL = SHEmptyRecycleBin(Form1.hWnd, "", SHERB_NOPROGRESSUI)
End Sub
کادر خصوصیات اکثرآ در نوشتن یک کاد آرشیو یا لیست فایل کاربرد دارد که شما روی نام فایل راست کلیک می کنید و این گزینه را معمولآ در انتهای لیست انتخاب می کنید واین کادر ظاهر میشود نوشتن چنین کد هایی باعث حرفه شدن برنامه ی شما می گردد
به ماژولمان کد های زیر را اضافه کنید
'------Typing New data For Propertis File---------------------
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
'---------------Conset For Propertis Dialog-------------------
Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Public Const ATTR_NORMAL = 0
Public Const ATTR_READONLY = 1
Public Const ATTR_HIDDEN = 2
Public Const ATTR_SYSTEM = 4
Public Const ATTR_VOLUME = 8
Public Const ATTR_DIRECTORY = 16
Public Const ATTR_ARCHIVE = 32
'-----------------------Declareing API------------------------------------------
Declare Function ShellExecuteEX Lib "shell32.dll" Alias _
"ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long
Public Function ShowFileProperties(filename As String, OwnerhWnd As Long) As Long
Dim SEI As SHELLEXECUTEINFO
With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = OwnerhWnd
.lpVerb = "properties"
.lpFile = filename
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With
ShellExecuteEX SEI
ShowFileProperties = SEI.hInstApp
End Function
حالا هر فایلی را که می خواهید خصوصییاتش نمایش داد شود به این تابع به صورت زیر ارسال کنید-پاس دهید
این کادر استفاده ی بسیار زیادی در برنامه های کاربردی داره.وموقعی استفاده می شه که کار بر باید یک پوشه رو (مثلآ برای نصب برنامه )انتخاب کنه
یک ماژول ایجاد کنید و کد های زبر رابنویسید
'------Typing New data For BrowsForm---------------------
Public Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
'---------------Conset For BrowsForm--------------------
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const BIF_DONTGOBELOWDOMAIN = 2
Public Const MAX_PATH = 260
'-----------------------Declareing API------------------------------------------
Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
حال در جایی که می خواهید کادر ظاهر شود کد زیر رابنویسید
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = "Select Folder... "
With tBrowseInfo
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
msgbox( sBuffer)
End If
در پایان خط م اقبل آخر با یک پیغام مسیر انتخاب شده کاربر اعلام می شود که شما عزیزان می توانید آنرا به دلخواه تغییر دهید
اموزش یک کار جالب با فرم ها
تنها با دو خط کد میتونید جلوه ای رو بوجود بیارید که فکرشم نمی کردید. یک فرم رو توی یک فرم دیگه جابدید. استفاده های زیادی میشه ازش کرد. مثلا ساخت نوار ابزارهایی مثل اونی که فتوشاپ داره. راجع بهش فکر کنید
این هم کدش
Private Declare Function SetParent Lib "user32" ( _
ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Sub Form_Load()
SetParent Form2.hWnd, hWnd
Form2.Show
End Sub
Option Explicit
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
بعد سه تا کامند برای ظاهر کردن آیکون ها مخفی کردن آنها و خروج از فرم بنویسید
کد هر کدام اینطور است
Private Sub cmdDHide_Click()
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 0
End Sub'--------------------------------
Private Sub cmdDShow_Click()
Dim hWnd As Long
hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd, 5
End Sub'---------------------------------
Private Sub cmdExit_Click()
Me.Hide
End
End Sub'-------------------------------------
البته حتما باید سریع به حالت قبل برگردونید چون موندن این حالت زیاد جالب نیست
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Const SPI_SCREENSAVERRUNNING = 97
حالا دو تا کامند به فرم اضافه کنید به اسم های Desabled و Enabled
کد دکمه غیر فعال کردن
Private Sub Disabled_Click()
Dim Ret As Long
Dim pOld As Boolean
Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
End Sub
کد فعال سازی این کلید ها بهتر است این کدها را در Unload فرم نیز فراخوانی کنید
Private Sub EnableD_Click()
Dim Ret As Long
Dim pOld As Boolean
Ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
End Sub
چطور می شه دکمه بستن پنجره در گوشه فرم رو غیر فعال کرد
شاید غیر فعال کرد دکمه های تمام صفحه و کمینه رو بلد باشین ولی
دیگه فرم خاصیت غیر فعال کردن دکمه close رو نداره مگه کنترل بوکس فرم رو
برداریم یا اصلآ فرم رو از نوع بدون منوی بالا وتیتر انتخاب کنیم
ولی با این کد می تونین با داشتن تمام کنترل ها فقط دکمه کلوز رو غیر فعال کنین
تابع زیر رو تعریف کنید
Public Const SC_CLOSE = &HF060
Public Const MF_BYCOMMAND = &H0
Public Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Sub DisableXbutton(ByVal frmHwnd As Long)
Dim hMenu As Long
hMenu = GetSystemMenu(frmHwnd, 0&)
If hMenu Then
Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
DrawMenuBar (frmHwnd)
End If
End Sub
مخفی کردن منوی Start
برای مخفی کردن منوی Start به یک تابع از کتابخانه user32.dll احتیاج دارید
Option Explicit
Dim hwnd1 As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
حالا باید دو تا دکمه برای مخفی و آشکار کردن منوی Startبه فرم اضافه کنید
کد مخفی کردن Start
Hwnd1=FindWindow("Shell_traywnd","")
call SetWindowPos(Hwnd1,0,0,0,0,0,SWP_HIDEWINDOW)
کد ظاهر کردن Start
call SetWindowPos(Hwnd1,0,0,0,0,0,SWP_SHOWWINDOW)
*****************************
آیکون یک برنامه رو از کالبدش کشید بیرون و به صورت فایل آیکون ذخیره کرد
این آموزش از سری آموزشی کتابخانه قدرتمند Shell هست
یک ماژول به پروژه اضافه کنید و کد زیر را داخلش کپی کنید
Public Const MAX_PATH = 260
Public Const SHGFI_DISPLAYNAME = &H200
Public Const SHGFI_EXETYPE = &H2000
Public Const SHGFI_SYSICONINDEX = &H4000 ' System icon index
Public Const SHGFI_LARGEICON = &H0 ' Large icon
Public Const SHGFI_SMALLICON = &H1 ' Small icon
Public Const ILD_TRANSPARENT = &H1 ' Display transparent
Public Const SHGFI_SHELLICONSIZE = &H4
Public Const SHGFI_TYPENAME = &H400
Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _
Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX _
Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE
Public Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Public Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
psfi As SHFILEINFO, _
ByVal cbSizeFileInfo As Long, _
ByVal uFlags As Long) As Long
Public Declare Function ImageList_Draw Lib "comctl32.dll" _
(ByVal himl&, ByVal i&, ByVal hDCDest& _
,ByVal x&, ByVal y&, ByVal flags&) As Long
Public shinfo As SHFILEINFO
یه دکمه به برنامه اضافه کنید و یک texbox و با دو تا picbox و دو تا برچسب
و اینکه نام picbox ها رو image1 و image2 قرار بدهید
آدرس فایل اجرایی را داخل texbox بنویسید و در کد کلیک دکمه کد زیر را بنویسید
Dim hImgSmall As Long
Dim hImgLarge As Long
Dim FileName As String
Dim r As Long
چون اکثر توابع مثلثاتی بر حسب رادیان کار می کنند گاهی اوقات نیاز داریم تا زوایا را از در جه به رادیان و بالعکس تبدیل کنیم. برای تبدیل یک زاویه بر حسب رادیان به درجه، آنرا در 180 ضرب کرده و سپس بر عدد پی تقسیم می‌کنیم:
Degree(x) = x * 180 / Pi
برای تبدیل یک زاویه بر حسب درجه به رادیان، آنرا در عدد پی ضرب کرده و سپس بر 180 تقسیم می‌کنیم:
Rad(x) = x * Pi / 180
*******************************
یک سری کدهای اماده ویژوال بیسیک براتون میزارم تا تمرین کنید
'frmtrst:
'give the nomber of numbers
'give n numbers
'get average
Option Explicit
Private Sub cmdcalculate_Click()
Dim totcount, totnum, ncount, inputno As Integer
Dim naver As Single
lbldisp.Caption = ""
totcount = Val(txtcount.Text)
Do While ncount < totcount
inputno = InputBox("Enter a no ", "input no")
ncount = ncount + 1
totnum = totnum + inputno
Loop
If totcount > 0 Then
naver = totnum / ncount
End If
lbldisp.Caption = "The average is " & naver
txtcount.Text = ""
End Sub
For i = 1 To 100
Print "*";
If i Mod 10 = 0 Then
Print
End If
Next i
End Sub
*******************************
'frm0605
'the most little
Option Explicit
Private Sub cmdsmall_Click()
Dim val1 As Long, val2 As Long, val3 As Long
val1 = txtone.Text
val2 = txttwo.Text
val3 = txtthree.Text
Call minimum(val1, val2, val3)
End Sub
Private Sub minimum(min As Long, y As Long, z As Long)
If y < min Then
min = y
End If
If z < min Then
min = z
End If
lblsmall.Caption = "smallest value is " & min
End Sub
*******************************
'count & print even
'frm0703
Option Explicit
Private Sub cmdprint_Click()
Dim s(9) As Integer
Dim x As Integer
Cls
For x = LBound(s) To UBound(s)
s(x) = 2 + 2 * x
Next x
For x = LBound(s) To UBound(s)
Print Space$(2) & x & Space$(7) & s(x)
Next x
End Sub
*******************************
'frm0706
Option Explicit
Dim marray(-5 To 5) As Integer
Private Sub cmdarray_Click()
Dim x As Integer
Call initialize
Call modifyarray(marray())
Call printmodified
End Sub
Private Sub cmdelement_Click()
Dim x As Integer
Call initialize
For x = LBound(marray) To UBound(marray)
Call modifyelement(marray(x))
Next x
Call printmodified
End Sub
Private Sub cmdexit_Click()
End
End Sub
Private Sub initialize()
Dim x As Integer
lstoriginal.Clear
lstmodified.Clear
For x = LBound(marray) To UBound(marray)
marray(x) = x
lstoriginal.AddItem marray(x)
Next x
End Sub
Private Sub printmodified()
Dim x As Integer
For x = LBound(marray) To UBound(marray)
lstmodified.AddItem marray(x)
Next x
End Sub
Private Sub modifyarray(a() As Integer)
Dim x As Integer
For x = LBound(a) To UBound(a)
a(x) = a(x) * 2
Next x
End Sub
Private Sub modifyelement(element As Integer)
element = element * 5
End Sub
Private Sub cmdprint_Click()
Dim bool As Boolean
Dim x As Integer
x = -1
Print "x" & vbTab & "bool"
Do Until x = 10
bool = x
Print x & vbTab & bool
x = x + 1
Loop
Print
bool = True
Print bool
bool = False
Print bool
End Sub
*******************************
'frmsecurity
Option Explicit
Dim maccesscode As Long
Private Sub cmd3_Click()
txtdisplay.Text = txtdisplay.Text & "3"
End Sub
Private Sub cmd4_Click()
txtdisplay.Text = txtdisplay.Text & "4"
End Sub
Private Sub cmd5_Click()
txtdisplay.Text = txtdisplay.Text & "5"
End Sub
Private Sub cmd6_Click()
txtdisplay.Text = txtdisplay.Text & "6"
End Sub
Private Sub cmd7_Click()
txtdisplay.Text = txtdisplay.Text & "7"
End Sub
Private Sub cmd8_Click()
txtdisplay.Text = txtdisplay.Text & "8"
End Sub
Private Sub cmd9_Click()
txtdisplay.Text = txtdisplay.Text & "9"
End Sub
Private Sub cmdclear_Click()
txtdisplay.Text = ""
End Sub
Private Sub cmdenter_Click()
Dim message As String
lstlongentery.Clear
maccesscode = Val(txtdisplay.Text)
txtdisplay.Text = ""
Select Case maccesscode
Case Is < 1000
message = "Aceess Denied "
Beep
Case 1645 To 1689
message = "Technican personnel"
Case 8345
message = "Custodial Services"
Case 55875
message = "Special Services"
Case 999898, 1000006 To 1000008
message = "Scientific Personal"
Case Else
message = "Acess DEnied "
End Select
lstlongentery.AddItem Now & Space$(3) & message
End Sub
Private Sub cmdone_Click()
txtdisplay.Text = txtdisplay.Text & "1"
End Sub
Private Sub cmdzero_Click()
txtdisplay.Text = txtdisplay.Text & "0"
End Sub
Private Sub cmd2_Click()
txtdisplay.Text = txtdisplay.Text & "2"
End Sub
Private Sub cmddivide_Click()
Dim numerator As Integer, denominator As Integer
Dim result As String
numerator = txtnum.Text
denominator = txtden.Text
result = divide(numerator, denominator)
If result = "" Then
lblthree.Caption = "divide by zero"
Else
lblthree.Caption = result
End If
End Sub
Private Function divide(n As Integer, d As Integer) As String
If d = 0 Then
Exit Function
Print "after exit function "
Else
divide = "division yields " & n / d
End If
End Function
*******************************
'frmfig0310
Option Explicit
Dim sum As Integer
Private Sub cmdadd_Click()
sum = sum + txtinput.Text
txtinput.Text = ""
txtsum.Text = sum
End Sub
Private Sub cmddraw_Click()
Dim side As Integer, row As Integer, column As Integer
side = txtinput.Text
Cls
If side <= 12 Then
If side > 0 Then
row = 1
While row <= side
column = 1
While column <= side
If row = 1 Or row = side Or column = 1 Or column = side Then
Print "<-PostContent->quot;;
Else
Print "&";
End If
column = column + 1
Wend
Print
row = row + 1
Wend
Else
Print "side too small "
Beep
End If
Else
Print "side too large "
Beep
End If
End Sub
Private Sub cmdcal_Click()
Dim years As Integer
Dim interestrate As Double
Dim amount As Currency
Dim principal As Currency
lstdisplay.Clear
years = 10
principal = txtamount.Text
interestrate = txtinterest.Text / 100
lstdisplay.AddItem "year " & vbTab & "amount on deposit"
For years = 1 To 10
amount = principal * (1 + interestrate) ^ years
lstdisplay.AddItem Format$(years, "@@@@") & vbTab & Format$(Format$(amount, "currency"), _
String$(17, "@"))
با این برنامه می تونین دو تا تصویر رو روی هم بندازید و حرکت بدین
تصاویرتون باید JPG باشه و بزرگ نباشه.دستورات زیر رو در قسمت General فرم بنویسید
Dim Image1 As IPictureDisp
Dim Image2 As IPictureDisp
Private Type Location
X As Integer
Y As Integer
End Type
Dim Image1Move As Integer
Dim Image2MoveX As Integer
Dim Image2MoveY As Integer
Dim Image1Local As Location
Dim Image2Local As Location
Const Operation = vbSrcAnd
دو تا عکس رو در مسیر برنامه کپی کنید اسمشون هم 1 و 2 باشه
کد زیر برای Form_Load هست
("Set Image1 = LoadPicture(App.Path & "\Image1.jpg
("Set Image2 = LoadPicture(App.Path & "\Image2.jpg
With me
.Show
Refresh.
.AutoRedraw = True
.ScaleMode = vbPixels
End With
If .X < -me.ScaleWidth Then .X = 0
If .Y < -me.ScaleHeight Then .Y = 0
If .X + me.ScaleWidth > me.ScaleWidth Then .X = -me.ScaleWidth
If .Y + me.ScaleHeight > me.ScaleHeight Then .Y = -me.ScaleWidth
End With
DoEvents
Loop
برای اینکه دستورات بالا داخل یک حلقه بی پایان قرار می گیره باید در رویداد کلیک فرم بنویسید
End
فرم رو زیاد بزرگ نکنید سعی کنید تصویرها هم اندازه باشند و فرم هم اندازه تصویر ها
برای اینکه در حرکت عکس ها تنوع ایجاد کنیم در رویداد MouseMove فرم دستور زیر رو بنویسید
اگر کاربر پنجره ای رو که شما تعیین می کنید رو باز کنه برنامه اون فرم رو می بنده.
در اینجا ما از دو تا تابع API استفاده می کنیم که عبارتند از : FindWindowA برای پیدا کردن پنجره مورد نظر و SetForegroundWindow برای فعال کردن پنجره مورد نظر که هر دوی این توابع در فایل user32.dll تعریف شده اند.
اول برای تعریف توابع فوق خطوط زیر رو در قسمت General وارد کنید :
Private Declare Function FindWindowA Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Dim Temp As Long
حالا روی فرمتون یه Timer قرار بدین و خاصیت Interval اون رو به 50 تغییر بدید، بعد روی اون دابل کلیک کنید و کد های زیر رو در Sub مربوط به Timer قرار بدین:
Temp = FindWindowA(vbNullString, "My Computer")
If Temp <> 0 Then
SetForegroundWindow (Temp)
SendKeys "%{F4}"
End If
دستور اول هندل ( لازم به ذکر است که سیستم عامل به هر کنترلی و به هر فرمی شماره ای اختصاص می ده که به این شماره میگن هندل) پنجره ای رو که ( در اینجا ) عنوانش My Computer باشد رو در متغیر Temp می ریزد. شرط بعدی چک می کند که پنجره مورد نظر پیدا شده یا نه که در صورت برقراری این شرط با تابع SetForegroundWindow (که آرگومانش همون شماره ای باید باشه که با تابع FindWindowA پیدا کردیم) پنجره پیدا شده رو فعال می کنه و در نهایت تابع SendKeys زهر خودش رو می ریزه و با ارسال یک کلید میانبر به نام Alt+F4 کاربر عزیز رو در باز کردن پنجره مورد نظرش ناکام می کنه!
*******************************
بدست آوردن IP و نام سیستم میزبان
برای امروز قصد دارم یک پروژه ساده را به شما معرفی کنم.
شما ظرف چند دقیقه میتوانید این پروژه را در ویژوال بیسیک بسازید.
ابتدا ویژوال بیسیک را باز کنید سپس کنترلر های زیر را روی فرم قرار دهید :
دو عدد TextBox و دو عدد WinSock
حالا روی فرم دو بار کلیک کرده و در رویداد لود فرم کدهای زیر را وارد کنید :
برنامه را اجرا کنید . این برنامه آی پی و پورت سیستم میزبان را در اختیار شما قرار میدهد.
لازم به ذکر است بعدا که به مرحله ساخت اسب های تراوا رسیدیم
خدمت شما عرض خواهم کرد که کاربرد این برنامه در هک سیستم قربانیان چیست
سوال :دستوری می خوام که بتونم یک کلمه را توی یک فیلد بانک اطلاعاتی جستجو کنم نه اینکه اون کلمه اول نوشته باشه . این کلمه ممکنه وسط هم نوشته شده باشه
برای کاری که می خوای انجام بدی باید از دستورات SQL استفاده کنی.
اگر از کامپونت ADO استفاده می کنی دستور جستجوش به این شرحه :
Ado1.RecordSource= "Select * From [your table] Where [your field] Like ('%متن مورد نظر برای جستجو%')"
ولی اگر از کامپونت Data استفاده می کنی دستورش اینطوری می شه :
Data1.RecordSource= "Select * From [your table] Where [your field] Like ('*متن مورد نظر برای جستجو*')"
مثال : مثلا من یک Table با نام Table1 و یک فیلد به نام Address دارم و می خوام تمام آدرسهایی که توشون ( تهران ) داره پیدا کنم ، حالا این کلمه می خواد هرجایی از فیلد باشه :
Ado1.CommandType = adCmdText
Ado1.RecordSource= "Select * From Table1 Where Address Like ('%تهران%')"
Ado1.Refresh
*******************************
بستن پنجره با گرفتن عنوان ان
اگر کاربر پنجره ای رو که شما تعیین می کنید رو باز کنه برنامه اون فرم رو می بنده.
در اینجا ما از دو تا تابع API استفاده می کنیم که عبارتند از : FindWindowA برای پیدا کردن پنجره مورد نظر و SetForegroundWindow برای فعال کردن پنجره مورد نظر که هر دوی این توابع در فایل user32.dll تعریف شده اند.
اول برای تعریف توابع فوق خطوط زیر رو در قسمت General وارد کنید :
Private Declare Function FindWindowA Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Dim Temp As Long
حالا روی فرمتون یه Timer قرار بدین و خاصیت Interval اون رو به 50 تغییر بدید، بعد روی اون دابل کلیک کنید و کد های زیر رو در Sub مربوط به Timer قرار بدین:
Temp = FindWindowA(vbNullString, "My Computer")
If Temp <> 0 Then
SetForegroundWindow (Temp)
SendKeys "%{F4}"
End If
دستور اول هندل ( لازم به ذکر است که سیستم عامل به هر کنترلی و به هر فرمی شماره ای اختصاص می ده که به این شماره میگن هندل) پنجره ای رو که ( در اینجا ) عنوانش My Computer باشد رو در متغیر Temp می ریزد. شرط بعدی چک می کند که پنجره مورد نظر پیدا شده یا نه که در صورت برقراری این شرط با تابع SetForegroundWindow (که آرگومانش همون شماره ای باید باشه که با تابع FindWindowA پیدا کردیم) پنجره پیدا شده رو فعال می کنه و در نهایت تابع SendKeys زهر خودش رو می ریزه و با ارسال یک کلید میانبر به نام Alt+F4 کاربر عزیز رو در باز کردن پنجره مورد نظرش ناکام می کنه!
» وقتی شما برنامه ای مانند ویژوال بیسیک را اجرا می کنید و در محیط کاری آن تغییراتی ایجاد می نمایید ، این تغییرات برای اجرای بعدی برنامه ثبت می شوند . برای مثال اگر شما ToolBox وی بی را مخفی کنید در اجرای بعدی آن ToolBox نمایش داده نخواهد شد . این امر در بسیاری از برنامه های دیگر نیز صدق میکند . این تغییرات که در اصطلاح ( Setting ) نام دارند یا در رجیستری یا در یک فایل ذخیره می شوند . خود VB این تغییرات را در رجیستری ثبت میکند و هنگام اجرا محیط خود را بر اساس این داده ها تنظیم می نماید .
» هنگامی که کلمه رجیستری در VB به گوش برنامه نویسان می رسد سریع ذهن آنها را متوجه توابع پیچیده API مربوط به کار با رجیستری می کند . برای همین من امروز می خواهم روش ذخیره کردن تنظیمات یک برنامه در رجیستری را بدون استفاده از توابع پیچیده مخصوص کار با رجیستری به وسیله دو تابع بسیار ساده مخصوص این کار به شما معرفی کنم :
» تابع SaveSetting : برای ساخت کلید و ذخیره کردن اطلاعات در رجیستری .
( SaveSetting ( AppName As String , Section As String , Key As String , Setting As String
_ AppName : این پارامتر مشخص کننده نام برنامه ( پروژه ) است . البته هر نوشته دیگری هم می تواند باشد که نام کلید اصلی در رجیستری را مشخص می کند .
_ Section : این پارامتر نا کلید زیر شاخه است که بیشتر از نام Setting برای آن استفاده می کنند .
_ Key : این پارامتر مشخص کننده نام کلید از نوع String است که داده ها در آن ذخیره می شوند .
_ Setting : این پارامتر هم که اصلی ترین بخش است همان داده یا مقداری است که در کلید ذخیره می شود .
» برای مثال : تابع با پارامتر های ورودی زیر مقدار رشته ( "1" ) را در کلید SampleKey ذخیره می کند .
_ شاید از خودتان بپرسید که مسیر این کلید در رجیستری چگونه است . کلیه این کلیدها و مقادیر که ایجاد می شوند در آدرس زیر قرار می گیرند و ما نمی توانیم از آدرس دیگری استفاده نماییم :
\HKEY_CURRENT_USER\Software\VB and VBA Program Settings
در مثال قبلی مقادیر در شاخه زیر ذخیره می شوند که شما می توانید با مراجعه به آن به این مطلب پی ببرید :
HKEY_CURRENT_USER\Software\VB and VBA Program Settings\Test\Setting
» تابع GetSetting : برای خواندن اطلاعات از رجیستری .
(GetSetting ( AppName As String , Section As String , Key As String , Setting As String
_ پارامتر های این تابع به جز گزینه آخر که در این تابع جایی ندارد دقیقا شبیه به هم هستند :
_ در این مثال مقدار ( 1 ) را که قبلا با تابع قبلی در کلید SampleKey قرار دادیم درون متغیر KeyValue قرار می گیرید .
» برنامه نمونه : حال می خواهیم برنامه جالبی با استفاده از این توابع معرفی شده بنویسیم .
شرح برنامه : می خواهیم برنامه ای بنویسیم که دارای تعداد مشخص اجرا باشد . یعنی کاربر فقط بتواند پنج بار این برنامه را اجرا کند و در هر بار اجرای آن پیغامی مبنی بر تعداد باقیمانده دفعات اجرا برای کاربر نمایش داده شود و هنگامی که این تعداد به پایان رسید پیغامی نمایش داده شود که دیگر کاربر نمی تواند این برنامه را اجرا نماید . مانند برنامه هایی که دارای قفل یا به اصطلاح رجیستری هستند .
_ برای این کار شما فقط کافی است کدهای زیر را در Form_Load برنامه خود قرار دهید :
()Private Sub Form_Load
Dim RunCount As String
( "RunCount = GetSetting("Test", "Setting", "RunCount
If Val(RunCount) > 5 Then
_,"مهلت اجرای برنامه به پایان رسیده و شما دیگر قادر به اجرای آن نخواهید بود"MsgBox vbExclamation , "اتمام مهلت"
End
Else
_ ,"شما فقط " & ((Str(4 - Val(RunCount & " بار دیگر می توانید این برنامه را اجرا کنید" MsgBox
vbInformation, "تعداد اجرای باقیمانده"
(SaveSetting "Test", "Setting", "RunCount", Str(Val(RunCount) + 1
End If
End Sub
حال فایل exe از برنامه خود بسازید و آن را اجرا نمایید
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public Function WinDir() As String
Dim Wind As String
Wind = Space(500)
Wind = Left(Wind, GetWindowsDirectory(Wind, Len(Wind)))
WinDir = Wind
End Function
*******************************
یکی از دوستان سوال کرده بودند که "چه جوری میشه برنامه خودشو کپی کنه تو فولدر StartUp ویندوز؟"
خوب شما باید از دستور FileCopy استفاده کنید به این ترتیب:
در این دستور که دستور کپی میباشد به جای:
Windows Drive درایو ویندوز را قرار دهید
User Name نام کاربر را بنویسید البته میتوانید از کلمه All Users نیز استفاده کنید که مخصوص تمام کاربران میباشد(نتیجه این کار را پس از رستارت میبینید)
در اینجا :
App.Path یعنی از درایو تا فولدر برنامه
App.EXEName یعنی نام فایل برنامه
".exe" به دلیل اینکه پسوند فایل نیز به دستور اضافه شود میباشد
*******************************
ساختن جدول در بانک اطلاعاتی
از منوی project گزینه refrences رو انتخاب کنید - بعد اونجا گزینه Microsoft ActiveX Data Objects 2.0 library پیدا کنیدو تیک بزنید - Adodc مورد نظرتون رو هم با دیتابیس set کنید - بعد :
Dim db_file As String
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim NumRec As Integer
Set conn = New ADODB.Connection
conn.ConnectionString = Adodc1.ConnectionString
conn.Open
On Error Resume Next
conn.Execute "DROP TABLE Jadid"
On Error GoTo 0
conn.Execute "CREATE TABLE Jadid(" & "One INTEGER NOT NULL," & "Two VARCHAR(40) NOT NULL," & "Three VARCHAR(40) NOT NULL)"
conn.Execute "INSERT INTO Jadid VALUES (1,'4','7')"
conn.Execute "INSERT INTO Jadid VALUES (2,'5','8')"
conn.Execute "INSERT INTO Jadid VALUES (3,'6','9')"
Set rs = conn.Execute("SELECT COUNT (*) FROM Jadid")
NumRec = rs.Fields(0)
