چند تا ترفند کاربردی در Visual Basic 6.0

*******************************
یکی از دوستان اموزش ارسال فایل با winsock رو خواسته بود که نمونش رو گذاشتم
http://www.iranvig.com/modules.php?name=News&file=article&sid=2253

کامپوننت ارسال نامه و ... توسط زبانهای مختلف از جمله VB
http://www.emailarchitect.net/smtpWEpo-5-08.htm
*******************************
این برنامه برای رشته کامپوتر خوبه (منظورم از نظر کاربرد این برنامه است) این برنامه برای یافتن مسیر در گراف با استفاده از الگوریتم دایجسترا هست .رو این برنامه از نظر گرافیکی خیلی خوب کار شده , این برنامه برای کسانی که می خوان کار با Pixel و مسائل مربوط به گرافیک در VB رو یاد بگیرن خوبه

http://matrix007.persiangig.com/vb/Dijkstra.rar

برنامه نمونه اعمال پوسته یا Skin روی فرم
http://mediavb.persiangig.com/ActiveX/Skin%20Form.zip

********************************
تشخیص فشرده شدن کليدهای کيبرد

یکی از دوستان سوال کرده بودند که چگونه می توان کلیدهای کیبرد را حتی وقتی فوکوس روی برنامه ما نیست تشخیص داد مانند دیکشنری ها که مثلاً با CTRL+F12 فعال می شوند و یا Keylogger ها که کلیدهای فشرده شده را ثبت می کنند
من دو روش زیر را برای اینکار پيشنهاد می کنم :

1 - استفاده از یک تابع کتابخانه ای به اسم GetAsyncKeyState موجود در کتابخانه user32.dll . این تابع ، فشرده شدن یا رها شدن یک کلید را تشخیص می دهد . نحوه declare کردن این تابع بصورت زیر است :

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

حال در برنامه تان یک timer قرار داده و در event آن کد زیر را قرار دهید :

For i = 1 To 255
results = 0
results = GetAsyncKeyState(i)
If results <> 0 Then
Msgbox(Chr(i))
End If
Next

برای مشاهده یک برنامه نمونه به این آدرس مراجعه کنید .
http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=36078&lngWId=1

2 - استفاده از قلاب یا Hook : قلاب ، یک ابزار در مکانیزم مدیریت پیغام سیستم ویندوز است که توسط آن برنامه ها می توانند یک روتین را برای مدیریت و پردازش پیغامهای خاصی قبل از اینکه آن پیغامها به برنامه مقصد برسند نصب نمایند . قلابها باعث کندی سیستم می شوند زیرا حجم پردازشی سیستم روی هر پیغام را افزایش می دهند بنابراین بایستی زمانیکه واقعاً به قلاب نیاز دارید آنرا نصب نموده و هر چه زودتر آنرا حذف نمایید . سیستم ویندوز از انواع زیادی از قلابها پشتیبانی می کند که هر کدام امکان دستیابی به پیغامهای خاصی را مهیا می نمایند برای مثال یک برنامه کاربردی می تواند با استفاده از قلاب کیبرد برای مدیریت و پردازش پیغامهای مربوط به آن ( مثل فشرده شدن یک کلید خاص یا رها شدن آن ) استفاده کند . 
برای نصب یک قلاب در برنامه از یک تابع کتابخانه ای به اسم SetWindowsHookEx استفاده می شود . این تابع یک قلاب را به زنجیره قلابهای سیستم اضافه می کند . نحوه declare کردن این تابع بصورت زیر است :

Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

همچنین برای آزاد کردن یک قلاب و حذف آن از زنجیره قلابها از تابع کتابخانه ای UnhookWindowsHookEx استفاده می گردد . نحوه declare کردن این تابع بصورت زیر است :

Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

برای ایجاد قلاب کیبرد همچنین نیاز به تعریف یک ثابت است که شماره قلاب کیبرد در آن قرار دارد :

Public Const WH_KEYBOARD = 2

حال بایستی یک تابع پس زمینه یا Callback Function نوشت که به ازای فشرده شدن کیبرد اجرا شود و آدرس آنرا ( با استفاده از کلمه کلیدی Address Of ) بهمراه ثابت فوق به تابع SetWindowsHookEx فرستاد .
*********************************
اموزش Visual basic
http://www.garmsarnews.com/evisualbasic/garmsarnewsvisualbasic1.pdf
http://www.garmsarnews.com/evisualbasic/garmsarnewsvisualbasic2.pdf
http://www.garmsarnews.com/evisualbasic/garmsarnewsvisualbasic3.pdf
http://www.garmsarnews.com/evisualbasic/visualbasic.pdf

*************************************
این برنامه برای ساختن Setup می باشد که با توجه به حجم کم این برنامه ولی بسیار قوی هست. این برنامه دارای امکانات زیادی می باشد به شما توصیه می کنم که حتماً دانلود کنید .

برای ساختن Setup شما باید بدانید که چه فایل هایی را باید به همراه فایل اجرایی بر روی سیستم هدف نصب کنید , شما برای اینکار می توانید یک بار توسط نرم افزار Package & Deployment Wizard که به همراه ویژوال بیسیک نصب می شود یک setup طراحی کنید , بعد از ساخت Setup یک فابل متنی به نام SETUP.LST در کنار فایل Setup.exe ایجاد می شود که در آن تمام فابل های مورد نیاز ذکر شده . 

اگر در ساخت Setup با استفاده از این برنامه به مشکل برخوردید لطفاً میل بزنید تا راهنمایتان کنم

دانلود
http://www.free-hoster.cc/users/matrix/downloads/QSetup.zip

**************************************

استفاده از شی File System Object در ویژوال بیسیک 
امروز می خوام درباره شی (File Sysytem Object ) که به FSO هم معروف است مطالبی را خدمت شما دوستان ارائه بدم ,این شی قابلیت کار با Drive , Folder , File , TestStream را دارد یعنی شما می توانید پوشه و یا فایلی را از مسیری به مسیر دیگر کپی و حذف و یا منتقل کنید و هم چنین می توانید پو شه ای را در مسیر مورد نظر ایجاد کنید

برای افزودن این شی به برنامه از منوی Project آیتم Refrencese را انتخاب کنید و از آن آیتم Microsoft Script Runtime را تیک می زنید . اکنون نوبت به تعریف یک متغیر از نوع ّFso می باشد

Dim Fso As New FileSystemObject

در ضمن لازم به ذکر است که App.path مسیر جاری را که برنامه اجرایی در آن قرار دارد را بر می گر داند .

Fso.CopyFile App.Path & "\text.txt", "C:\", True ' True For Ovwerwrite
fso.MoveFile App.Path & "\text.txt", "C:\" ' For Move File Of Current Path to "C:\" Path
fso.DeleteFile "c:\text.txt"

همین عملیات بالا را می توان برای Folder هم اجرا کرد . همان طور که متوجه شده اید این شیء بسیار مهم است و می تواند کاربرد های زیادی برایتان داشته باشد مثلاً من در زیر برنامه ای می نویسم که بتواند فایلی را در پو شه System32 ویندوز کپی کند خوب بر ای اینکه بتوان پوشه ویندوز را پیدا کنیم از یک API استفاده می کنم چون امکان داره ویندوز داخل پوشه هایی غیر از نام Windows باشد این کار بر ای بر نامه هایی که می خواهید فایلی را در پوشه ویندوز کپی کنی دکاربرد دارد مثلاً شما می خواهید فونتی را در پوشه font ویندوز کپی کنید.

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long _
) As Long

Dim fso As New FileSystemObject
Public S As String
Public SysDirectory As Long

Private Sub Command1_Click()
fso.CopyFile App.Path & "\vb.txt", S + "\System32\", True
End Sub

Private Sub Form_Load()
S = Space(255)
'Get the Windows directory
WinDirectory = GetWindowsDirectory(S, 255)
S = Left$(S, WinDirectory)

'#######################################

LblSource.Caption = "Source : " & App.Path & "\vb.txt"
LblDestination.Caption = "Destination : " & S & "\System32\"
End Sub

دانلود برنامه نمونه
https://www.sharemation.com/vbcoder/vb/Copy.zip?uniq=-buiawi
*****************************

چگونه از اجراي مجدد يک برنامه در ويژوال بيسيک جلوگيري کنیم؟
خوب با استفاده از کد زير در فرم اصلي برنامه تان مي توانيد از اجراي مجدد (Duplicate) برنامه جلوگيري کنيد

Private Sub Form_Load()
If App.PrevInstance = True Then
Dim Result As Integer
Result = MsgBox("برنامه در حال اجراست", vbInformation, "Warnnig")
Unload Me
End If 
End Sub

******************************
برنامه خاموش کردن Windows با يک کليک
در اين برنامه يک پروژه ساده رو به شما معرفی ميکنم که در اون با يک کليک ساده دکمه ميتوانيد ويندوز رو
خاموش کنيد . برای ساخت اين پروژه مراحل زير را طی کنيد :
۱ - ويژوال بيسيک را باز کنيد 
۲ - يک فرم جديد ايجاد کنيد
۳ - از جعبه ابزار ويژوال يک دکمه روی فرم قرار دهيد 
۴ - روی دکمه دو بار کليک کرده و دستور زير را در رويداد کليک دکمه تایپ کنيد 

Shell ("Shutdown ") ' Shuts computer down 

همانطور که ديده ميشود در صورت اجرای و فشار دکمه ويندوز خاموش ميشود.
اين دستور دارای سويچ های خاص ميباشد که ميتوانيد در برنامه خود استفاده کنيد . در زير اين 
سويچ ها ارائه شده اند :

' Switches:
l Log off profile
s Shut down computer
r Restart computer
f Force applications to close
t Set a timeout for shutdown
m \\computer name Shut down remote computer
i Show the Shutdown GUI 

مثال :

Shell ("Shutdown -s -t 5") ' Shuts computer down after timeout of 5

بعنوان مثال در صورت استفاده از فرمان فوق سيستم بعد از 5 ثانيه خاموش ميشود. دقيقا مطابق کدی 
که در ويروس ام اس بلستر استفاده شده با اين تفاوت که مدت انتظار برای خاموش شدن سيستم در 
اين ويروس 30 ثانيه است

**************************************
چگونه وقفه ايجاد کنيم : مثلا برای بارگذاری فرم

Sub Pause(interval)
Dim Current
Current = Timer
Do While Timer - Current < Val(interval)
DoEvents
Loop
End Sub

*******************************
بيل گيتس : جهاني فكر كنيد؟ محلي عمل كنيد!
*******************************
یک بسته اموزشی کامل که نمیگم چیه و اگه دانلود نکنی از دستت رفته
هر سه بخش رو دانلود کنید و سپس unzip کنید و حجمش کم است

http://www.sharemation.com/MahdiVB678/new2/New.part1.rar?uniq=yvuarx
http://www.sharemation.com/MahdiVB678/new2/New.part2.rar?uniq=yvuarr
http://www.sharemation.com/MahdiVB678/new2/New.part3.rar?uniq=yvuarl

*******************************
تشخیص ادمین بودن کاربر جاری در ویندوز

اگه زمانی خواستید این موضوع رو بفهمید کافیه که از تابع API ی که در shell32 تعریف شده استفاده کنید. صورت کلی این تابع چنین است:

Private Declare Function IsUserAnAdmin Lib "shell32" () As Long

تحت ویندوز 2000 ممکنه که شما خطای با عنوان Can't find DLL entry point دریافت کنید که بهتر است که معرفی تابع را بدین گونه انجام دهید:

Private Declare Function IsUserAnAdmin Lib "shell32" Alias "#680" () As Long

*******************************
DLL ( Dynamic Link Library )
شاید برای شما این سوال مطرح باشد که بعنوان یک برنامه‌نویس حرفه‌ای چگونه می‌توانید با ویژوال بیسیک توابع خود را درون فایلهای DLL بنویسید و در مواقع لزوم آنرا بعنوان توابع API در ویژوال بیسیک یا سایر زبانها مورد استفاده قرار دهید. چیزی که در زبانهایی مانند ویژوال سی و ... راحت قابل دسترس و تولید می‌باشند. چنانچه در خود VB فقط مورد استفاده‌تان باشد که خب از طریق کلاس‌ها قابل پیاده‌سازی است، اما اگر نیاز به این شد تا در نرم‌افزارهایی که امکان ساخت توابع سطح پایین در آنها مقدور نیست مورد استفاده قرار گیرند چه باید کرد؟ بعنوان مثال در نرم‌افزار MultiMedia Builder یا Wise Install Master که امکان صدا زدن توابع API در آنها پیش‌بینی شده است.

حتی کاربرد دیگری که می‌توان برای این تکنیک جست، جهت کم کردن حجم برنامه اصلی و مهندسی‌تر شدن پروژه است. شما ماژول‌های متنوعی از برنامه را درون فایل‌های DLL تعریف کنید و در پروژه و در هنگام لزوم از آن استفاده کنید، چیزی که در اکثر نرم‌افزارهای مهندسی وجود دارد که می‌توان به PlugIn‌ها اشاره کرد. همانند نرم‌افزار Winamp.
برای این منظور شما را با مقاله‌ای در این باب آشنا می‌کنم که امکان بهره‌برداری از آن نیز وجود دارد.
به آدرس http://www.vb-helper.com/howto_make_standard_dll.html مراجعه کنید تا شرح کاملی در اینباره بیابید.
برای نمونه عملی هم این فایل را دانلود کنید.

http://www.vb-helper.com/HowTo/howto_make_standard_dll.zip

*******************************
تبدیل متن به گفتار جالبه Speech SDK 4.0

http://downloads.pcworld.com/pub/new/graphics_and_multimedia/audio/audio_tools/sapi4sdk.exe

*******************************
ضبط صدا به فرمت دلخواه با ویژوال بیسیک

با این برنامه‌ به فرمت دلخواه صدا را ضبط کنید. آن هم به شکلی خیلی ساده.
راه‌های زیادی برای رسیدن به ضبط صدا هست! اما هدف من در اینجا ضبط صدا به فرمت دلخواه است، مثلا mp3 و بدون استفاده از ابزارهای برنامه‌نویسی نظیر ActiveX و ...
ما می‌خواهیم با استفاده از توابع API‌ به این هدف برسیم. توابع در دسترس برای پخش و ضبط صدا عبارتند از mciSendString، mciSendCommand و mciExecute. (برای آشنا شدن با این توابع می‌توانید به سراغ MSDN بروید.)
این توابع هر کدام پیچیدگی خاص خودشان را دارند. مخصوصا اگر قصد ضبط صدا را داشته باشید که باید پارامترهای زیادی را تنظیم کنید که نرخ‌نمونه برداری، تعداد کانال صوتی، بافر و ... را شامل میشوند.
من قصد دارم شما را با تابع mciSendCommand آشنا کنم که با وجود پیچیدگی بیش از حد، استفاده راحت‌تری از آن هم میسر هست و البته به طریقی که آموزش می‌دهم.
بهتر هست با یک مثال شروع کنیم:
شکل کلی این تابع این چنین هست:

Public Declare Function mciSendCommand Lib "winmm.dll" _
Alias "mciSendCommandA" (ByVal wDeviceID As Long, _
ByVal uMessage As Long, _
ByVal dwParam1 As Long, _
ByVal dwParam2 As Any) As Long

پخش فایل صوتی شامل چند مرحله است:
1- باز کردن فایل صوتی
2- دستور پخش
3- بستن فایل (که حتما باید انجام بشه)
باز کردن فایل صوتی خود شامل پارامترهایی است که در ساختار زیر مشخص میشود:

Private Type MCI_OPEN_PARMS
dwCallback As Long
wDeviceID As Long
lpstrDeviceType As String
lpstrElementName As String
lpstrAlias As String
End Type

البته باید ذکر کنم که برخی پارامترها در شرایط خاصی مقدار دهی می‌شوند تا کار مشخصی را انجام دهند (پارامتر سوم، بعدا مثال میآرم)
کد زیر یک فایل صوتی را باز می‌کند و هندل آن را در صورت موفقیت جایی نگه می‌داریم، چون از این به بعد ما با این هندل خیلی کار داریم.
پارامتر آخر از تابع mciSendCommand حاوی ساختار مرتبط با نحوه عمل است. 

Dim dwReturn As Long
Dim mciOpenParms As MCI_OPEN_PARMS
'Open a waveform-audio device with filename for play.
mciOpenParms.lpstrDeviceType = "WaveAudio"
mciOpenParms.lpstrElementName = filename dwReturn = mciSendCommand(0, MCI_OPEN, _
MCI_OPEN_ELEMENT Or MCI_OPEN_TYPE, _
mciOpenParms)
If dwReturn Then
MsgBox "Failed to open device; don't close it, just return error."
Exit Sub
End If 'The device opened successfully; get the device ID.
wDeviceID = mciOpenParms.wDeviceID

و برای پخش از کد زیر استفاده می‌کنیم که بعد از کد باز کردن فایل میگذاریم:

dwReturn = mciSendCommand(wDeviceID, MCI_PLAY, 0, vbNull)
If dwReturn Then
mciSendCommand wDeviceID, MCI_Close, 0, vbNull
MsgBox "MCI_PLAY not succed!"
Exit Sub
End If

اگر دقت کنید پارامتر سوم مقدار صفر را داراست. این پارامتر می‌تواند به نحوی مشخص شود که با اجرای دستور پخش، کنترل به برنامه داده شود یا تا زمانی که پخش به اتمام نرسیده برنامه منتظر بماند. و مشخه‌های دیگر.
چون ذکر نکردیم پس کنترل برنامه را در حین پخش در دست می‌گیریم.
و سرانجام با این کد فایل را می‌بندیم:

Dim dwReturn As Long dwReturn = mciSendCommand(wDeviceID, MCI_Close, MCI_WAIT, vbNull)
If dwReturn Then
mciSendCommand wDeviceID, MCI_Close, 0, vbNull
MsgBox "MCI_Close not succed!"
Exit Sub
End If

و اما ضبط صدا. برای ضبط باید از ساختار پیچیده زیر استفاده کنیم:

Private Type MCI_WAVE_SET_PARMS
dwCallback As Long
dwTimeFormat As Long
dwAudio As Long
wInput As Long
wOutput As Long
wFormatTag As Integer
wReserved2 As Integer
nChannels As Integer
wReserved3 As Integer
nSamplesPerSec As Long
nAvgBytesPerSec As Long
nBlockAlign As Integer
wReserved4 As Integer
wBitsPerSample As Integer
wReserved5 As Integer
End Type

برای یک ضبط ساده باید این همه پارامتر را مقدار دهی کنید و تازه ممکن است صدا بر اساس مقادیر اشتباه بی کیفیت و نامطلوب ضبط شود.
از همه اینها که بگذریم قصد من این بود تا ترفندی را به شما آموزش بدهم که خیلی راحت صدا را به هر فرمتی که خواستید ضبط کنید.

.:: CODEC ::.
این کلمه مخفف واژه‌های COmpress/DECompress هست و به زبان ساده‌تر درایوری است که عمل کدسازی و دیکودسازی اطلاعات را انجام می‌دهد، البته برای کاربر محسوس نیست و به نوعی در پشت پرده انجام می‌گیرد.
وقتی شما فایلهای wav را در سیستم پخش می‌کنید، باید codec فایلهای wav در سیستم نصب شده باشد وگرنه قادر به پخش نیستید که البته بهمراه ویندوز این درایورها نصب میشوند.
برای فایلهای mp3 نیز همین قضیه صادق هست و غیره.
برای اینکه بدانید بر روی سیستم شما چه codecهایی نصب شده مراحل زیر را دنبال کنید:

Control Panel -> Sound & Audio Device -> Hardware -> select Audio Codec from list -> click on Properties.

با این توضیحاتی که آمد می‌خواهیم بر اساس یکی از codecهای نصب شده اقدام به ضبط صدا کنیم.
لازم به ذکر است که برخی codecها فقط حاوی بخش پخش هستند و امکان ضبط رو ندارند!
برسیم به هدف اصلی از این صحبت‌ها.

1- Sound Recorder ویندوز رو باز کنید و سپس از منوی File گزینه Save As...‌ را انتخاب کنید.
2- دکمه Change را کلیک کنید تا لیست codec ها ظاهر شود.
3- گزینه Format را با codecی که می‌خواهید تنظیم کنید.
4- OK کنید و بعد نام فایل را مشخص کنید و Save‌ نمائید.

با طی این 4 مرحله شما یک فایل صوتی ساختید که فقط حاوی تنظمیات صدا است. یعنی تمام پارامترهای ساختار MCI_WAVE_SET_PARMS

حالا اگر با تابع mciSendCommand‌ این فایل را باز کنید و اقدام به ضبط صدا نمائید، در واقع دارید به فرمتی که می‌خواهید صدا را ضبط می‌کنید و درگیر تنظیمات خاصی نیستید.
سورسی را که مربوط به همین بخش است، این صحبت‌ها را پیاده‌سازی کرده و نمونه کاملی از ضبط و پخش به فرمت دلخواه را انجام می‌دهد.
و این نکته که دو فایل با پسوند mrf در کنار برنامه هست، در واقع فایل‌های حاوی ساختار هستند(wav)‌ که پسوندشان عوض شده.

برنامه ابتدا لیست تمام فایلهای با پسوند mrf‌ را لیست می‌کند و در هنگام ضبط به همان فرمتی که انتخاب می‌کنید اقدام به ضبط می‌کند.
شما می‌توانید هر ساختاری را که دوست داشتید با Sound Recorder بسازید و با پسوند mrf در کنار برنامه ذخیره کنید و از نزدیک با چگونگی عمل ضبط آشنا شوید.

http://h1.ripway.com/PalizeSoftware/Files/WaveRecordTest.zip

*******************************
معرفی هیستوگرام تصویر و چگونگی تهیه آن

شبیه سازی نمودار هیستوگرام در فتوشاپ
هیستوگرام مشخص کننده میزان روشنایی یا تیرگی تصویر هست.
به عبارتی تعداد پیکسل‌های تصویر ما را در بازه‌ای از دو رنگ تیره(مشکی) و روشن(سفید) مشخص می‌کند، یعنی همان نمودار فراوانی رنگ پیکسل‌ها.
در سطوح حرفه‌ای برای یک عکاس این نمودار حائز اهمیت است، چرا که به روشنی یا تیرگی عکس پی می‌برد. امروزه دوربین‌های دیجیتال سطح بالا قادر هستند تا بعد از شکار عکس، نمودار هیستوگرام آنرا نمایش دهند.
سورس زیر این نمودار را بر اساس همین روش پیاده کرده و هیستوگرام مربوطه را با قابلیت تفکیک کانال‌های قرمز، سبز و آبی به نمایش می‌گذارد

http://h1.ripway.com/PalizeSoftware/Files/Histogram.zip

*******************************
تبدیل به سطوح خاکستری (GrayScale)

امروز برای شما سورسی رو تدارک دیدم که بتونید تصاویر رنگی رو به تصاویر خاکستری (GrayScale) تبدیل کنید.
در واقع تبدیل یک پیکسل رنگی به طرح خاکستری خیلی راحت صورت می‌گیرد.
می‌دونیم که هر رنگ دارای سه مؤلفه قرمز، سبز و آبی است. برای تبدیل به طرح خاکستری کافیه که رنگ قرمز رو در ضریب 0.3، سبز رو در ضریب 0.59 و آبی رو در ضریب 0.11 ضرب کنید.
در آینده شما رو با تکنیک‌های دیگه‌ای در زمینه گرافیک آشنا خواهم کرد. پس چه بهتر که شما بفرمائید در چه زمینه‌هایی مشتاق هستید بدونید

http://h1.ripway.com/PalizeSoftware/Files/GrayScale.rar

*******************************
فایلهای Zip

قابلیت فشرده‌سازی و استخراج فایلهای فشرده (در نوع ZIP) رو به نرم‌افزارهای خود اضافه کنید یه خبر قابل دانلود دارم. فایل زیر که بصورت API مورد استفاده قرار می‌گیره (اصل موضوع همینه که می‌تونید در هر نرم‌افزاری که قابلیت فراخوانی توابع API‌ رو داره بکار بگیرید.) قادره با سرعت بالا (وحشتناک و غیر قابل تصور) اقدام به فشرده‌سازی و استخراج این قبیل فایلها بپردازه.
حتی قادرید مشخص کنید که از چه نوع فشرده‌سازی استفاده کنه. ضمن اینکه قادرید بصورت CallBack‌ پیشرفت کارش رو هم تحویل بگیرید یعنی خیلی برنامه‌نویس رو تحویل گرفته‌اند که این رو هم نوشته‌اند!
نکته آخر اینکه این موضوع رو (با همین عنوان) قبلا در سایت برنامه‌نویس قرار داده بودم و برای دوستانی که ممکنه ندیده باشند، اینجا هم گذاشتم

http://h1.ripway.com/PalizeSoftware/files/bszipdll.zip

*******************************
زیر نظر گرفتن تغییرات یک شاخه یا زیر شاخه

با گوگل دسک‌تاپ کار کردید؟ اگر نه که پیشنهاد می‌کنم حتما یکبار امتحان کنید تا به ارزشش پی ببرید. با برنامه‌هایی که در پشت پرده عمل ایندکس‌گذاری فایلها رو انجام می‌دهند چی، آشنا هستید؟ منظور برنامه‌هایی که کار جستجو رو راحت می‌کنند تا کاربر سریع‌تر به جستجوی فایلها بپردازد. آیا اینگونه برنامه‌ها بطور مداوم باید فایلها و پوشه‌ها رو زیر نظر داشته باشند تا به محض رؤیت تغییر جدید، بانک خود را اصلاح کنند؟ اگر بدین شکل باشد که این کار پردازنده را زیر بار می‌برد، نه؟
حالا اگر این کار در بطن سیستم‌عامل نهفته باشد و به محض تغییر محتویات اعم از ایجاد و حذف فایل، تغییر فایل، تغییر خصلت فایل، اندازه و ... در مسیری به ما اطلاع داده شود، کار ما ساده‌تر شده و بار زیادی هم از روی دوش پردازنده برداشته می‌شود. سورس زیر رو ببینید تا بطور عملی در نحوه استفاده از این قبیل توابع آشنا شوید.

http://h1.ripway.com/PalizeSoftware/Files/watchdir.rar

*******************************
فیلتر کردن بعضی از کلید های صفحه کلید

Private Sub Form_KeyPress(KeyAscii As Integer)
Dim svalid As String
svalid = "0123456789"
If InStr(svalid, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
MsgBox "Not valid Keys.please Press 0-9 keys"
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
MsgBox "The form cannot be close.farzad dh."
Dim leftI As Long
Dim rightI As Long
leftI = Form1.Left + 1000
rightI = Form1.Top + 1000
Dim a As New Form1
a.Width = Me.Width
a.Height = Me.Height
a.Left = leftI
a.Top = rightI
a.Show
End Sub
*******************************
یک کار جالب با موس

فقط یک تایمر با زمان 500 روی فرم قرار بدین و این کدها رو داخلش کپی کنید
Dim farzadvb
Dim bestforvb6
Dim temp
Randomize 1000

farzadvb = Rnd(10) * 1000

bestforvb6 = Rnd(10) * 1000

temp = SetCursorPos(farzadvb, bestforvb6)

********************************
چگونه متن داخل يک TextBox را Select کنيم :

Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub

*******************************
چگونه مسير نصب ويندوز را پيدا کنيم :

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 استفاده کنید به این ترتیب:

FileCopy App.Path + "\" + App.EXEName + ".exe", "Windows Drive\Documents and Settings\User Name\Start Menu\Programs\Startup" + "\" + App.EXEName + ".exe" 'Copy Function

در این دستور که دستور کپی میباشد به جای:
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) 

conn.Close 

MsgBox "Created ... " 

*******************************
کتابچه سورس

يكي از راههاي اينكه شما بتونيد روش كد نويسي رو خوب ياد بگيريد و يا از كدهاي استاندارد و از پيش نوشته شده در برنامه هاتون به خوبي استفاده كنيد اينه كه از كدهاي نوشته شده كتابها استفاده كنيد. به همين دليل هم به دوستان عزيز پيشنهاد مي كنم براي اين منظور به سايت انتشارات Wrox سر بزنن و از هر كتابي كه دلشون ميخواد هر سورسي رو دوست دارن بردارن. شما مي تونيد از كدهاي اونها كه واقعاً با توضيحات خوب نوشته شدن استفاده كنيد. براي اين منظور به این ادرس بروید
http://www.wrox.com/dynamic/books/download.aspx

*******************************
نحوه تولید DLL با ویژوال بیسیک

بعنوان یک زبان برنامه‌نویسی با توسعه سریع، ویژوال بیسیک نظر خیلی از برنامه‌نویسان را از جهت سادگی به خود معطوف کرد. برنامه‌نویسی با ویژوال بیسیک در کمترین زمان صورت می‌گیرد حال آنکه در مقابل زبانهایی چون C و ++C اغلب اوقات به روزها کار مفید نیاز است.
اما بیشترین انتقادی که برنامه‌نویسان از ویژوال بیسیک دارند در این است که قادر به تولید کتابخانه‌های پویا (DLL) نیست. حقیقتا این نظر مورد قبول است که نمی‌توان این نوع فایلها را در کنار فایلهای اجرایی(Exe) یا ActiveX Exe تولید کرد.
در این مقاله ما قصد داریم که نگاه دقیقی به نحوه تولید فایلهای اجرایی در ویژوال بیسیک یندازیم و بعد با طی مراحل ساده‌ای موفق به ایجاد فایلهای DLL بشویم تا از زیر بار این انتقاد نیز رهایی یابیم.
قبلا به این موضوع اشاره شد که فایهای DLL آن دست از برنامه‌هایی هستند که یکبار نوشته می‌شوند و در پروژه‌های بعدی بکرات می‌تواند از آنها استفاده برد. چیزی که هسته ویندور را تشکیل می‌دهد اینگونه فایلها هستند. علاوه بر آن تکنیک‌هایی وجود دارد که شما را قادر می‌سازد تا برنامه‌هایی بنویسید که قادرند خود را بروز برسانند و یا خود ترمیم باشند. بهتر از آن اینکه برنامه‌ای بنویسید که با الحاق اینگونه فایلها بدان قدرت و امکانات جدید بدان افزود. همانند نرم‌افزارهای رایج از جمله Winamp.

کتابخانه‌های پویای قابل اتصال (DLL) چه هستند؟

یک DLL مجموعه‌ای از توابع و پروسه‌هایی است که می‌تواند از برنامه یا DLLهای نظیر خود فراخوانده شود. 

استفاده از اینگونه کتابخانه‌های دو مزیت اصلی دارد:
1- امکان به اشتراک گذاری از کد را فراهم می‌سازند. یک DLL می‌تواند مورد استفاده خیلی از برنامه‌های قرار گیرد. بعنوان مثال کتابخانه Win32 API نمونه‌ای از این سری فایلها است. بعلاوه از زمانی که پروسه‌های گوناگون قادر به فراخوانی یک DLL واحد هستند امکان به اشتراک گذاری کد‌ها و روتین‌ها فراهم آمده است. یک فایل DLL تنها یکبار به درون حافظه لود می‌شود و بارها توسط پروسه‌های گوناگونی مورد استفاده قرار می‌گیرد و این یعنی مدیریت حافظه بهتر.

2- مزیت دیگر امکان نوشتن برنامه‌ها بصورت اجزای منفصل است که این اجزا خود قابل تعویض با نگارش‌های جدیدتر جهت توسعه نرم‌افزار خواهند بود بدون اینکه خطی از کد برنامه اصلی دگرگون شود.

با این توصیف فایلهای کتابخانه‌ای درونی که در پروژه‌های مورد استفاده قرار می‌گیرد در صورت تغییر نیاز هست تا پروژه اصلی دوباره کمپایل شود تا بتوان با آن ارتباط بر قرار کرد. اما در DLL ها چون بصورت پویا و قابل انعطاف نوشته شده‌اند این اتصال در بیرون از بدنه اصلی و درست در زمان فراخوانی آن قبیل از متدها و توابع شکل می‌گیرد و این خود تفاوت آشکار از مزیت این گونه از فایلها می‌باشد.همچنین یک فایل DLL می‌تواند حاوی توابعی باشد که فقط مورد استفاده خود هست و از درون به آن دسترسی نخواهیم داشت و آندسته از تابعی را که نیاز هست معرفی می‌کنیم تا از بیرون بدان دسترسی داشته باشیم. در این مرحله نیاز به معرفی در فایلهای Def هست که در پروژه‌های C و C++ مورد استفاده قرار می‌گیرد.

و اما ساختار DLL
فایلهای DLL حاوی یک مدخل شروع انتخابی (optional entry point) و پایانی هستند که در زمانی که توسط برنامه‌های دیگر به درون حافظه لود یا آنلود می‌شوند قابل اجرا است. ویندوز این پروسه را در زمانی که یک برنامه DLLها را بدرون حافظه لود یا آنلود می‌کند اجرا می‌کند.
این دو نوع پروسه به DLL این امکان را می‌دهد که یک سری از مقدمات را پیش از استفاده مهیا کند یا بعد از استفاده پاکسازی نماید. در ویژال بیسیک این تابع بدین گونه تعریف می‌شود:

Public Function DllMain(hinstDLL As Long, fdwReason As Long , lpwReserved As Long) As Boolean

که پارامترهای آن بدین قرارند:
hInstDLL که حاوی یک مقدار یکتا بعنوان دستگیره فایل DLL است.
fdwReason مشخص کننده دلیل فراخوانی این پروسه توسط سیستم‌عامل است که یکی از چهار مقدار زیر را به خود منتصب می‌کند:
DLL_PROCESS_ATTACH (1): یک پروسه در حال لود DLL به دورن حافظه است. هر پیش‌نیاز باید در اینجا شکل گیرد.
DLL_THREAD_ATTACH (2): یک ریسمان (Thread) برای این DLL در حال تولید است. هر پیش‌نیاز برای ایجاد ریسمان در این مرحله می‌تواند شکل بگیرد.
DLL_THREAD_DETACH (3) ریسمان در حال پایان یافتن است. به منظور پاک‌سازی DLL از حافظه.
DLL_PROCESS_DETACH (0) فایل DLL در حال خروح از حافظه است. بمنظور پاک‌سازی سایر کارها توسط برنامه‌نویس امکان انجام در این مرحله فراهم آمده است.

lpvReserved: حاوی مقدار اضافی در استفاده از DLL_PROCESS_ATTACH یا DLL_PROCESS_DETACH می‌باشد.
مقدار برگشتی تابع DllMain در هنگام صدا زدن بصورت DLL_PROCESS_ATTACH مقدار TRUE را باید به خود بگیرد.

در تلاش برای تولید و توسعه یک DLL نمونه قصد این را داریم که یک کتابخانه ریاضی تشکیل دهیم. کد زیر در ماژولی بنام MathLib.Bas قرار می‌گیرد:

Option Explicit
Public Const DLL_PROCESS_DETACH = 0
Public Const DLL_PROCESS_ATTACH = 1
Public Const DLL_THREAD_ATTACH = 2
Public Const DLL_THREAD_DETACH = 3


Public Function DllMain(hInst As Long, fdwReason As Long, lpvReserved As Long) As Boolean
Select Case fdwReason
Case DLL_PROCESS_DETACH
' No per-process cleanup needed
Case DLL_PROCESS_ATTACH
DllMain = True
Case DLL_THREAD_ATTACH
' No per-thread initialization needed
Case DLL_THREAD_DETACH
' No per-thread cleanup needed
End Select
End Function


Public Function Increment(var As Integer) As Integer
If Not IsNumeric(var) Then Err.Raise 5

Increment = var + 1
End Function


Public Function Decrement(var As Integer) As Integer
If Not IsNumeric(var) Then Err.Raise 5

Decrement = var - 1
End Function


Public Function Square(var As Long) As Long
If Not IsNumeric(var) Then Err.Raise 5

Square = var ^ 2
End Function
*******************************
توابع SaveSetting و GetSetting

» وقتي شما برنامه اي مانند ويژوال بيسيك را اجرا مي كنيد و در محيط كاري آن تغييراتي ايجاد مي نماييد ، اين تغييرات براي اجراي بعدي برنامه ثبت مي شوند . براي مثال اگر شما 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 ذخيره مي كند .

"SaveSetting "Test" , "Setting" , "SampleKey" , "1

_ شايد از خودتان بپرسيد كه مسير اين كليد در رجيستري چگونه است . كليه اين كليدها و مقادير كه ايجاد مي شوند در آدرس زير قرار مي گيرند و ما نمي توانيم از آدرس ديگري استفاده نماييم :

\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 

_ پارامتر هاي اين تابع به جز گزينه آخر كه در اين تابع جايي ندارد دقيقا شبيه به هم هستند :

( " KeyValue = GetSetting ( " Test" , "Setting" , "SampleKey

_ در اين مثال مقدار ( 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 از برنامه خود بسازيد و آن را اجرا نماييد

*******************************
سوال :دستوری می خوام که بتونم يک کلمه را توی يک فيلد بانک اطلاعاتي جستجو کنم نه اينکه اون کلمه اول نوشته باشه . اين کلمه ممکنه وسط هم نوشته شده باشه

برای کاری که می خوای انجام بدی باید از دستورات 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 کاربر عزیز رو در باز کردن پنجره مورد نظرش ناکام می کنه!

*******************************
بدست آوردن IP و نام سيستم ميزبان

برای امروز قصد دارم يک پروژه ساده را به شما معرفی کنم. 

شما ظرف چند دقيقه ميتوانيد اين پروژه را در ويژوال بيسيک بسازيد.

ابتدا ويژوال بيسيک را باز کنيد سپس کنترلر های زير را روی فرم قرار دهيد :

دو عدد TextBox و دو عدد WinSock

حالا روی فرم دو بار کليک کرده و در رويداد لود فرم کدهای زير را وارد کنيد :

Text1.Text = Winsock1.LocalIP
Text2.Text = Winsock2.LocalHostName

برنامه را اجرا کنيد . اين برنامه آی پی و پورت سيستم ميزبان را در اختيار شما قرار ميدهد.
لازم به ذکر است بعدا که به مرحله ساخت اسب های تراوا رسيديم
خدمت شما عرض خواهم کرد که کاربرد اين برنامه در هک سيستم قربانيان چيست

*******************************
تبدیل رادیان به درجه

چون اکثر توابع مثلثاتی بر حسب رادیان کار می کنند گاهی اوقات نیاز داریم تا زوایا را از در جه به رادیان و بالعکس تبدیل کنیم. برای تبدیل یک زاویه بر حسب رادیان به درجه، آنرا در 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

*******************************
'frm421 
'10*10 stars 
Option Explicit 

Private Sub cmdstar_Click() 
Dim i As Integer 

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 

*******************************
'frmboolean 
Option Explicit 

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 

*******************************
'frmfig0614 
Option Explicit 

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 cmdexit_Click() 
End 
End Sub

*******************************
'frmdraw 
Option Explicit 

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 "$"; 
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

*******************************
'frmdisplay 
Option Explicit 

Private Sub cmdprint_Click() 
Dim counter As Integer 
txtinput.SetFocus 
counter = 0 
counter = Val(txtinput.Text) 
lbldisplay.Caption = "" 
'txtinput.SetFocus 
Do While counter > 0 
lbldisplay.Caption = lbldisplay.Caption & "#" 
counter = counter - 1 
Loop 
End Sub

*******************************
'frmcompund 
Option Explicit 

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, "@")) 

Next years 
End Sub 

Private Sub cmdexit_Click() 
End 
End Sub

نظرات شما عزیزان:

نام :

آدرس ایمیل:

وب سایت/بلاگ :

متن پیام:

نظر خصوصی

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

 

 

 

عکس شما

آپلود عکس دلخواه: