تاپیک کد های ویژوال بیسیک

حمید تورو جونه داداشی برش دار :(((((((((((((((((((((((((((((((((((

wingknight;8406:
حمید تورو جونه داداشی برش دار :(((((((((((((((((((((((((((((((((((

چیو بر دارم؟

- - - - - - - - - به دلیل ارسال پشت سر هم پست ها ادغام شدند - - - - - - - - -

کد یه ماشین حساب ساده که می تونه چهار عمل اصلی رو روی دو عدد انجام بده
لینک دانلود فرم ویژوال بیسیک
http://s3.picofile.com/file/8188770368/Form1.frm.html

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

Shell "taskkill /f /im " & Text1.Text, vbHide

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

Private Sub Form_Load()
List1.Clear

    Dim hSnapShot As Long, uProcess As PROCESSENTRY32
    hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
    uProcess.dwSize = Len(uProcess)
    r = Process32First(hSnapShot, uProcess)
    Me.AutoRedraw = True
    Do While r
        List1.AddItem Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0))
        r = Process32Next(hSnapShot, uProcess)
    Loop

    CloseHandle hSnapShot

End Sub

یادم رفت بگم قبل اینها برای اجرای این دستورات باید کد های اجرایی و توابع api لازم رو در بخش جنرال وارد کنید

Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "Kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "Kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long)

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

موفق باشید یاعلی

- - - - - - - - - به دلیل ارسال پشت سر هم پست ها ادغام شدند - - - - - - - - -

حرکت موس به صورت خودکار
سلامی دوباره
با یه کد تازه برای شما اینجا اومدم
تا به حال خواستین برنامه ای بنویسید که موس رو خود به خود حرکت بده روی صفحه نمایش؟؟
مثلا بره به مختصات فلان و دابل کلیک کنه!اونم خودش به صورت خودکار بدون هیچ دخالت دست و موس!
این کد میتونه موس شما رو حرکت بده،شما تنها میتونید با تغییر خیلی جزئی به خواسته خودتون برسید و کد ها رو اونطور که خودتون میخواید تغییر بدین .

Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
'before you start this program, i suggest you save everything that wasn't saved yet.
Private Declare Sub mouse_event Lib "user32" (ByVal dwflags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, ByVal dwextrainfo As Long)
Const mouseeventf_leftdown = &H2
Const mouseeventf_leftup = &H4
Const mouseeventf_middledown = &H20
Const mouseeventf_middleup = &H40
Const mouseeventf_move = &H1
Const mouseeventf_absolute = &H8000
Const mouseeventf_rightdown = &H8
Const mouseeventf_rightup = &H10
Private Sub Command1_Click()

    For i = 25 To 1023
        For j = 0 To 767
    ret& = SetCursorPos(i, j)
    Next j
    Next i
    
End Sub

کلا من عاشق این کد ها شدم میدونید چرا؟؟؟ چون توی زمان دانش اموزی و دانشجویی با این کد ها حالی میکردم ویروس میساختم میدادم دست بچه ها که همش موس اونها روی صفحه حرکت میکرد اونها هم نمیتونستن کنترلش کنن. خیلی با حال بود.
اما شما از این کار های بد بد نکنین(:3:)
یا علی

ماشین حساب پیچیده تر
http://s6.picofile.com/file/8177438642/New_folder.rar.html
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -' Program : Cal' Author : H.A.M.I.D'''' - - - - - - - - - - - - - - - - - -- - - - - - - - - - - - - - - - - - - - - - - -Option ExplicitDim strPreviousValue As StringDim strOperator As StringDim blnDot As BooleanDim strMemory As StringDim blnDisplay As BooleanDim strAuthor As StringPrivate Sub Form_Load() lblDisplay.Caption = "0" strPreviousValue = "" strMemory = "0" strOperator = "" blnDot = False blnDisplay = True strAuthor = " Coded by:H.A.M.I.D,"
End SubPrivate Sub cmdNumber_Click(Index As Integer) If blnDisplay = True Then If blnDot = False And lblDisplay.Caption = "0" Then lblDisplay.Caption = "" End If lblDisplay.Caption = lblDisplay.Caption + cmdNumber(Index).Caption Else strPreviousValue = lblDisplay.Caption lblDisplay.Caption = cmdNumber(Index).Caption blnDisplay = True End IfEnd SubPrivate Sub cmdDot_Click() If blnDisplay = True Then If blnDot = False Then blnDot = True lblDisplay.Caption = lblDisplay.Caption + "." End If Exit Sub End If If blnDisplay = False And blnDot = False Then lblDisplay.Caption = "0." blnDisplay = True blnDot = True End IfEnd SubPrivate Sub cmdCE_Click() If Timer1.Enabled = True Then Timer1.Enabled = False blnDot = False lblDisplay.Caption = "0" strOperator = "" strPreviousValue = "0" 'strMemory = "0"End SubPrivate Sub cmdOperator_Click(Index As Integer) blnDot = False blnDisplay = False If Len(strOperator) = 1 Then Call math strOperator = cmdOperator(Index).Caption Else strOperator = cmdOperator(Index).Caption strPreviousValue = lblDisplay.Caption End IfEnd SubPrivate Function math() On Error GoTo errorHandler Select Case strOperator Case "+" lblDisplay.Caption = Val(lblDisplay.Caption) + Val(strPreviousValue) Case "-" lblDisplay.Caption = Val(strPreviousValue) - Val(lblDisplay.Caption) Case "x" lblDisplay.Caption = Val(lblDisplay.Caption) * Val(strPreviousValue) Case "/" lblDisplay.Caption = Val(strPreviousValue) / Val(lblDisplay.Caption) End Select Exit FunctionerrorHandler: lblDisplay.Caption = "Error " strOperator = "" strPreviousValue = "0" blnDot = False blnDisplay = FalseEnd FunctionPrivate Sub cmdIsEqualTo_Click() Call math strOperator = "" If Len(lblDisplay.Caption) <= 19 Then lblDisplay.FontSize = 15 Else lblDisplay.FontSize = 10 End IfEnd SubPrivate Sub cmdPlusOrMinus_Click() lblDisplay.Caption = Val(lblDisplay.Caption) - (Val(lblDisplay.Caption) + Val(lblDisplay.Caption))End SubPrivate Sub cmdSqrt_Click() lblDisplay.Caption = Sqr(Val(lblDisplay.Caption))End SubPrivate Sub cmdMemory_Click(Index As Integer) If Timer1.Enabled = False Then Select Case cmdMemory(Index).Caption Case "M+" strMemory = Val(strMemory) + Val(lblDisplay.Caption) Case "M-" strMemory = Val(strMemory) - Val(lblDisplay.Caption) Case "MR" lblDisplay.Caption = strMemory blnDisplay = False Case "MC" strMemory = "0" lblDisplay.Caption = "0" End Select End IfEnd SubPrivate Sub Timer1_Timer() strAuthor = Mid$(strAuthor, 2, Len(strAuthor) - 1) + Left(strAuthor, 1) lblDisplay.Caption = Left(strAuthor, 18)End Sub

برنامه تست املا!
با سلام
اینم یه سری کد دیگه اینها رو وقتی سال اخر متوسطه بودم نوشتم شاید ه نظر دوستان راه حل هایی که به کار بردم یه کم مبتدیانه باشن یا شکل نوشتم توابع و ... ولی با این همه برنامه به خوبی جواب میده!
این کد ها یک سری توابع هستند که من داخل یک کلاس قرار داده بودم و از اونها فایل dll ای ساختم و در برنامه هام از اون استفاده میکردم
این کد ها میتونن صحت یک متن یا یک کلمه رو از نظر املایی برسی کنن و تعداد اشکالات املایی در متن رو به شما برگردونن.

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

برای شروع شما باید توابعی که در برنامه ورد افیس موجوده رو به برنامه ویژوال وارد کنید تا بتونید در کد ها از اون استفاده کنید که باید از قسمت Performance گزینه Micro soft word 12.0 Object روتیکش رو بزنین
حالا باید یه متغیر حاوی توابع ورد بسازیم اینوری

Private mwordref As Word.Application
Private Sub Class_Initialize()
Set mwordref = New Word.Application
End Sub

و یه شي از نوع اون تعریف میکنیم!

حالا باید از این توابع در برنامه یا ملاسمون استفاده کنیم!
این تابع چک میکنه کلمه وارد شده از نظر املایی درسته یا نه!

Public Function spellcheckword(ByVal s As String) As Boolean
spellcheckword = mwordref.CheckSpelling(s)
End Function

توی این تابع اگه کلمه وارد شده به متغیر sغلط باشه مقدرار برگشتی False در غیر اینصورت True رو برگشت میده!

حالا شاید بخوایم تعداد کلمات متن رو بشمریم تا بتونیم اونها رو یکی یکی از نظر املایی چک کنیم
این کار رو این تابع برای ما انجام میده!

Public Function numword(ByVal text As String) As Integer
Dim a As Variant, b As Variant
a = Split(text)
numword = UBound(a)
End Function

این دستور متن رو تیکه تیکه میکنه توی یه ارایه میزاره بعد تعدارد خونه های اون ارایه رو میشماره و تعدا اونها به دست میاد!

حالا تابع اصلی
این تابع متن رو دریافت میکنه توش تعداد کلمات رو میشمره
متن رو تیکه تیکه میکنه
میفرسته به تابع صحت املا و تعداد اشتباهات رو در متغیری جمع و برگشت میده!

Public Function textspell(ByVal text As String) As String
Dim a As Variant, re As Boolean
Dim b As Integer
b = 1
    For i = LBound(a) To UBound(a)
        re = spellcheckword(a(i))
            If re <> True Then
                textspell = False
                b = 0
                Exit For
            End If
    Next i
If b = 1 Then
    textspell = True
    Exit Function
End If
                
End Function

و تا به اینجا کارمون تمومه ولی یه تابع خیلی مهم دیگه مونده!

Public Function about()
MsgBox ("Omid Moradpour Dashtaki"  )
End Function

خخخخخخخ
خوب کار ما تموم شد دوستان شاید کد ها رو کمی جا به جا گذاشته باشم اما سعی کردم طوری بزارم که علاقه مندا بتونن راحت بخونن و مهمتر اینکه درکش کنن!
یا علی فردا بازم میزارم!