تبلیغات


برنامه نویسی $هک&آموزش&کتاب - چندتا ترفند از ویژوال بیسیک 2006


برنامه نویسی $هک&آموزش&کتاب
 
ایران سرای من

محل درج آگهی و تبلیغات
 

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

*******************************
این برنامه برای رشته کامپوتر خوبه (منظورم از نظر کاربرد این برنامه است) این برنامه برای یافتن مسیر در گراف با استفاده از الگوریتم دایجسترا هست .رو این برنامه از نظر گرافیکی خیلی خوب کار شده , این برنامه برای کسانی که می خوان کار با 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
 

.: Weblog Themes By Pichak :.


تمامی حقوق این وبلاگ محفوظ است | طراحی : پیچک

پیچک