میخوام اینجا سورس های برنامه های جالب که از سایت های خارجی یا ایرانی پیدا میکنم بزارم .
1-سوء استفاده نکنید
2-خودتون هم بزارید
3-تشکر یادتون نره
Printable View
میخوام اینجا سورس های برنامه های جالب که از سایت های خارجی یا ایرانی پیدا میکنم بزارم .
1-سوء استفاده نکنید
2-خودتون هم بزارید
3-تشکر یادتون نره
با یک دستور Shell به راحتی دکمه Shutdown طراحی کنید.
با دستور ("Shell ("Shutdown -s -t 60 این کار را انجام دهید.
یک دکمه بر روی فرم قرار دهید و دستور مذکور را در آن کپی کنید.
زمان خاموش کردن سیستم ۶۰ ثانیه هست مقدار دلخواه خود را وارد کنید.
پارامترها:
s- باعث خاموش شدن سیستم می شود به جای آن مقادیر زیر رامی توانید وارد کنید.
r- : ریست کردن سیستم
t-: مدت زمان مورد نظر برای خاموش شدن سیستم
""""""""""بقیه کارا هم خودتون امتحان کنید"""""""""""
كتابخانه وسيع شل
این چند تا رو امتحان کنید تا بقیش رو بزارم
تازه اول کاریم رفته رفته پیشرفته ترم میشن سورس ها
[HTML]Shell "arp"
Shell "drvspace"
Shell "drwatson"
Shell "explorer"براي my document
Shell "freecell"
Shell "ftp"براي تنظيم اف تي پي
Shell "ipconfig"كادر آي پي
Shell "mplayer"مديا پلير
Shell "mshearts"
Shell "nbtstat"
Shell "netstat"
Shell "calc"ماشين حساب
Shell "notepad"نوت پد
Shell "packager"
Shell "pbrush"نقاشي[/HTML]
کدی برای دیدن تمام ارورهای vb
[HTML]Private Sub Command1_Click()
Dim x As String
For i = 1 To 1000
x = Error(i) & Errordiscreption
List1.AddItem i & "=" & x
Next i
End Sub
Private Sub Command2_Click()
End
End Sub
[/HTML]
سورس یک بچه ویروس(قفل ماوس )
استفاده درست بکنید نه برای خرابکاری
[html]Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Public A
Private Sub Form_Load()
BlockInput True
A = 6
End Sub
Private Sub Label1_Click()
End Sub
Private Sub Timer1_Timer()
A = A - 1
label1.caption="الان آزاد میشه "
If A < 1 Then
BlockInput False
Timer1.Interval = 0
Label1.ForeColor = RGB(255, 0, 0)
label1.caption="سونامی"
End If
End Sub
[/html]
اینا هم بقیه دستورات شل بازم دارم
[HTML]Shell "ping"
Shell "regedit"ريجيستري
Shell "route"روت
Shell "scandskw"اسكن ديسك
Shell "scanregw"اسكن رگ
Shell "setdebug"كخك تري تنظيم ويندوز
Shell "sigverif"
Shell "cdplayer"سي دي پلير
Shell "sndrec32"ضبط صدا
Shell "sndvol32"تنظيم ولوم صدا
Shell "sol"همون سول
Shell "taskman"وضعيت سي پي يو
Shell "telnet"تلفن
Shell "vcmui"
Shell "winfile"
Shell "winipcfg"
Shell "winmine"
Shell "winrep"
Shell "charmap"كاراكتر مپ
Shell "winver"
Shell "write"وورد پد
Shell "wscript"
Shell "cleanmgr"كلنر پاك كننده اشغال درايو
Shell "control"كنترل پنل
Shell "cvt1"
Shell "defrag"دفراگمنت
Shell "drvspace" فضاي خالي ديسك[/HTML]
نمی خواد نظر بدین حتما براتون مفید نیست
خسته نباشی دوست عزیز
ادامه بده
حتما حتی برای شما هم که شده انجام میدم
دوست عزيز ادامه بدهيد فقط لطف كنيد توي هر پست توضيحات كاملي رو ارئه بديد و يا اگه نمي تونيد توضيح كامل بديد حداقل بگيد كه اين كد دقيقا چه كارايي رو انجام ميده . موفق باشي.
من که برای همه توضیح دادم شما کدومو میگید ؟نقل قول:
اين يه نمونه سورس یک بچه ویروسنقل قول:
استفاده درست بکنید نه برای خرابکاری
خوب حالا كار اين ويروسه چيه ؟
سونامی عزیز اگه اجازه بدی من هم میخوام کمکت کنم که تنها نباشی :11:
موافقی ؟
خوشحال میشم دوست عزیز منو کمک کنینقل قول:
شما چندتا فعلا بزار تا تاپیک پایین نره منم به زودی میزارم
فقط یک command button به فرم اظافه کنید
[HTML]Private Sub Command1_Click()
Dim i, x, y
Me.FontSize = 26
Me.ForeColor = 0: x = CurrentX: y = CurrentY
For i = 0 To 444
Print "Coded By : Faraz Azadi" ' Here goes your text.
x = x + 1: y = y + 1: CurrentX = x: CurrentY = y
Next i
Me.ForeColor = 255
Print "Coded By : Faraz Azadi"
End Sub
[/HTML]
موفق باشید
فقط این کد ها رو به قسمت جنرال فرمتون اظافه کنید
[HTML]Sub Form_Paint()
Dim I As Integer, X As Integer, Y As Integer
Dim C As String
Cls
Me.FontSize = 12
For I = 0 To 91
X = CurrentX
Y = CurrentY
C = Chr(I)
CurrentX = X
CurrentY = Y
ForeColor = RGB(Rnd * 256, Rnd * 256, Rnd * 256)
Print "Coded By : Faraz Azadi"
Next
End Sub
[/HTML]
موفق و سر بلند باشید:11:
با این کد میتونید عکس picturebox1 رو به صورت برعکس در picturebox2 نمایش بدیم
فقط برای این کار کافی یک Commandbutton و دو picturebox به فرم اظافه کنید و بعد برای pixturebox1 یک عکس انتخاب کنید .
[HTML]Private Sub Command1_Click()
Picture2.PaintPicture Picture1.Picture, 0, 0, Picture1.Width, _
Picture1.Height, Picture1.Width, 0, -Picture1.Width, _
Picture1.Height, vbSrcCopy
End Sub
[/HTML]
موفق و سر بلند باشید [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]
خسته نباشی خیلی عالیه بازم بذار
فقط کافیه یه command button به فرم اظافه کنید و در قسمت روال command1 به جای 5555555 شماره مورد نظرتون رو بنویسید .
[HTML]Private Declare Function tapiRequestMakeCall Lib "TAPI32.DLL" _
(ByVal DestAddr$, ByVal AppName As String, _
ByVal CalledParty As String, ByVal Comment As String) As Long
Private Sub Command1_Click()
tapiRequestMakeCall ",5555555", App.Title, "called", ""
End Sub
[/HTML]
موفق باشید :8:
برای این کار فقط کافیه این کد ها رو در فورمتون قرار بدین
[HTML]Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long
Private Sub Form_Load()
SHShutDownDialog 0
End Sub
[/HTML]
یا حق :5:
فقط کافیه 2 عدد command button به فرمتون اظافه کنید و کد های زیر رو در فرمتون بزارید
[HTML]Private 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
Private Sub Command1_Click()
mciSendString "set cdaudio door open", "", 0, 0
End Sub
Private Sub Command2_Click()
mciSendString "set cdaudio door closed", "", 0, 0
End Sub
[/HTML]
به امید همکاری دوستان ................ :10:
سلام به همه
سونامی عزیز کجایی پس ؟
یک تایمر و دو Label به فرم اضافه کنید و سپس کدها را کاملا پاک کرده و کدهای زیر را وارد کنید
[HTML]Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim CurPos As POINTAPI
Private Sub Form_Load()
Timer1.Interval = 1
End Sub
Private Sub Timer1_Timer()
GetCursorPos CurPos
Label1.Caption = "X : " + Str(CurPos.X)
Label2.Caption = "Y : " + Str(CurPos.Y)
End Sub
[/HTML]
موفق باشید :5:
من امدم این چند روزه که نبودم سیم کشی ساختمونمون به هم ریخته بود .ولی الان درست شده و به زودی شروع میکنم براتون کد کذاشتن
با این کد می توانید:
1) پخش فایل های صوتی
2)نور دادن به taskbar ( اگر نفهمیدید آن را امتحان کنید)
3)ایجاد شفافیت
4)آوردن فرم بر روی تمامی برنامه ها
5)غیر فعال کردن دکمه ی Close
6)نمایش / مخفی Start Menu
7)غیر فعال / فعال TaskManager
8)نمایش / مخفی آبکون های روی Desktop
9)نمایش خصوصیات یک فایل
10)خالی کردن سطل آشغال
11)نمایش محل نصب ویندوز
12)رفتن به یک سایت
13)مخفی کردن یک رنگ در فرم
کد زیر را در یک Module قرار دهید.
اگر نمی توانید این کار را انجام بدهید فایل module را از اینجا دانلود کنید:کد:'______________________________________________________________________________
'Number Title preamble Keyword |
'------------------------------------------------------------------------------
'| 1 | PlaySound | only wav format | SoundPlay |
'---------------------------------------------------------------------------- |
'| 2 | FlashWindow | In the taskbar | TaskbarFlash |
'---------------------------------------------------------------------------- |
'| 3 | Transparency | opacity | Transparency |
'---------------------------------------------------------------------------- |
'| 4 | AlwaysOnTop | Bring to front | alwaysOnTop |
'---------------------------------------------------------------------------- |
'| 5 | XButton | Disable X button | Xbutton |
'---------------------------------------------------------------------------- |
'| 6 | StartMenu | hide/show start menu | StartMenu |
'---------------------------------------------------------------------------- |
'| 7 | Ctrl + Alt + Delete | disabe Ctrl + Alt + Delete | C_A_D |
'---------------------------------------------------------------------------- |
'| 8 | DesktopIcon | Show/Hide desktop icon | DesktopIcon |
'---------------------------------------------------------------------------- |
'| 9 | ShowProperties | show properties of a file | ShowPro |
'---------------------------------------------------------------------------- |
'| 10 | EmptyRecycleBin | EmptyRecycleBin | EmpthRe |
'-----------------------------------------------------------------------------|
'| | | Get system dir ( before use,| |
'| | | first type GD and then in| |
'| 11 | GD and systemDic | the new line use systemDic.| GD and then: |
'| | | For examole : first trpe GD| SystemDic |
'| | | and in new line type: | |
'| | | MsgBox SystemDic | |
'------------------------------------------------------------------------------
'| 12 | WWW | Go to web site | go to web site|
'------------------------------------------------------------------------------
'| 13 | TransOne | Do not show a color | TransOne |
'------------------------------------------------------------------------------
'ENJOY IT :]
'SMNsoft®
Option Explicit
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
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
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
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Const SC_CLOSE = &HF060
Public 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
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Dim hWnd1 As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Const SWP_HIDEWINDOW = &H80
Const SWP_SHOWWINDOW = &H40
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 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
Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long
lpIDList As Long
lpClass As String
hkeyClass As Long
dwHotKey As Long
hIcon As Long
hProcess As Long
End Type
Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Public Const ATTR_NORMAL = 0
Public Const ATTR_READONLY = 1
Public Const ATTR_HIDDEN = 2
Public Const ATTR_SYSTEM = 4
Public Const ATTR_VOLUME = 8
Public Const ATTR_DIRECTORY = 16
Public Const ATTR_ARCHIVE = 32
Declare Function ShellExecuteEX Lib "shell32.dll" Alias _
"ShellExecuteEx" (SEI As SHELLEXECUTEINFO) As Long
Private Declare Function SHEmptyRecycleBin Lib "shell32.dll" Alias "SHEmptyRecycleBinA" (ByVal hwnd As Long, ByVal pszRootPath As String, ByVal dwFlags As Long) As Long
Const SHERB_NOPROGRESSUI = &H2
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Public SystemDic As String
Public SysDirectory As Long
Public Function ShowFileProperties(filename As String, OwnerhWnd As Long) As Long
Dim SEI As SHELLEXECUTEINFO
With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = OwnerhWnd
.lpVerb = "properties"
.lpFile = filename
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With
ShellExecuteEX SEI
ShowFileProperties = SEI.hInstApp
End Function
Public Sub Xbutton(Name_Of_Your_FORM As Form)
Dim hMenu As Long
hMenu = GetSystemMenu(Name_Of_Your_FORM.hwnd, 0&)
If hMenu Then
Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
DrawMenuBar (Name_Of_Your_FORM.hwnd)
End If
End Sub
Public Function TaskbarFlash(Name_Of_Your_FORM As Form)
FlashWindow Name_Of_Your_FORM.hwnd, 1
End Function
Public Function SoundPlay(Adress_Of_Music_File As String, Play As Boolean)
If Play = True Then
PlaySound Adress_Of_Music_File, 1, 1
ElseIf Play = False Then
PlaySound Adress_Of_Music_File, 6, 6
End If
End Function
Public Function AlwaysOnTop(hwnd As Long, Topmost As Boolean)
If Topmost = True Then
AlwaysOnTop = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
Else
AlwaysOnTop = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
AlwaysOnTop = False
End If
End Function
Public Function Trans(Name_Of_Your_FORM As Form, Opacity As Double)
On Error Resume Next
Dim Ret As Long
Ret = GetWindowLong(Name_Of_Your_FORM.hwnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Name_Of_Your_FORM.hwnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes Name_Of_Your_FORM.hwnd, 0, Opacity, LWA_ALPHA
End Function
Public Function StartMenu(Show_Start_Menu As Boolean)
If Show_Start_Menu = True Then
Call SetWindowPos(hWnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW)
ElseIf Show_Start_Menu = False Then
hWnd1 = FindWindow("Shell_traywnd", "")
Call SetWindowPos(hWnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW)
End If
End Function
Public Function C_A_D(Enable__CTRL_ALT_DELETE As Boolean)
If Enable__CTRL_ALT_DELETE = True Then
Dim Ret0002 As Long
Dim pOld As Boolean
Ret0002 = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
ElseIf Enable__CTRL_ALT_DELETE = False Then
Dim Ret0001 As Long
Dim pOld001 As Boolean
Ret0001 = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld001, 0)
End If
End Function
Public Function DesktopIcon(ShowIcon As Boolean)
If ShowIcon = True Then
Dim hWnd001 As Long
hWnd001 = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd001, 5
ElseIf ShowIcon = False Then
Dim hWnd002 As Long
hWnd002 = FindWindowEx(0&, 0&, "Progman", vbNullString)
ShowWindow hWnd002, 0
End If
End Function
Public Function ShowPro(Name_Of_Your_FILE As String, Name_Of_Your_FORM As Form)
ShowFileProperties Name_Of_Your_FILE, Name_Of_Your_FORM.hwnd
End Function
Public Function EmptyRe(Name_Of_Your_FORM As Form)
Dim retvaL
retvaL = SHEmptyRecycleBin(Name_Of_Your_FORM.hwnd, "", SHERB_NOPROGRESSUI)
End Function
Public Function GD()
Dim WinDirectory As String
SystemDic = Space(255)
WinDirectory = GetWindowsDirectory(SystemDic, 255)
SystemDic = Left$(SystemDic, WinDirectory)
End Function
Public Sub www(ByRef Site As String)
On Error Resume Next
ShellExecute 0, "Open", Site, "", "", vbNormalFocus
End Sub
Public Function TransOne(Red As Byte, Green As Byte, Blue As Byte, Name_Of_Form As Form) As Long
On Error Resume Next
Dim Ret As Long
Dim CLR As Long
CLR = RGB(Red, Green, Blue)
Ret = GetWindowLong(Name_Of_Form.hwnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Name_Of_Form.hwnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes Name_Of_Form.hwnd, CLR, 20, LWA_COLORKEY
End Function
حالا اگر با استفاده از آن مشکل دارید یک نممونه از استفاده از آن را از اینجا دانلود کنید.کد:http://smn-soft.persiangig.com/VB/SMNsoft_CODE.bas
کد:http://smn-soft.persiangig.com/VB/SMNsoft%20Code%20collection%20v%201.zip
چرا هیچ کسی دیگه نمیاد من این چند روز پشت سرهم به مشکل خوردم الان تا حدودی حل شده خوب باید شروع کنم به جست وجو