پاییز 88 - آموزش ویژوال بیسیک

تکمیل کردن آدرس در TextBox

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

این تابع بصورت اتوماتیک آدرس رو براتون تکمیل میکنه

دانلود

کلمات کلیدی : سورس کد، وی بی6، تکمیل کردن آدرس در TextBox

نوشته شده توسط مهدی در چهارشنبه 88/9/25 و ساعت 4:26 عصر | نظرات دیگران()

ایجاد لیست html از تصاویر درون یک پوشه

این برنامه از تصاویر درون یک پوشه خاص لیست اچ تی ام ال درست میکنه

فقط باید آدرس مسیر حاوی عکسها و فرمت اونهارو به تابع زیر ارسال کنید:

Public Sub convert(path As String, pattern As String)
On Error GoTo z
Open path + "\List.html" For Output As 1
Print #1, "<HTML>"
Print #1, "<HEAD>"
Print #1, "<TITLE>" & path & "</TITLE>"
File1.path = path
File1.pattern = pattern
For i = 0 To File1.ListCount
If File1.List(i) = "" Then Exit Sub
s = File1.path + "\" + File1.List(i)
x = "<A href="" & s & """ & "><IMG WIDTH=100 HEIGHT=100 SRC="" & s & ""></a>"
Print #1, x
Next i
Exit Sub
z:
MsgBox Err.Deion
End Sub

دانلود

کلمات کلیدی : وی بی 6، سورس کد، ایجاد لیست html از تصاویر درون یک پوشه

نوشته شده توسط مهدی در چهارشنبه 88/9/25 و ساعت 4:21 عصر | نظرات دیگران()

بدست آوردن ایام هفته

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

Public Function DayName(strDate As String) As String
Select Case Weekday(strDate)
    Case 7:
        DayName = "شنبه"
    Case 1:
        DayName = "یکشنبه"
    Case 2:
        DayName = "دوشنبه"
    Case 3:
        DayName = "سه شنبه"
    Case 4:
        DayName = "چهارشنبه"
    Case 5:
        DayName = "پنج شنبه"
    Case 6:
        DayName = "جمعه"
End Select
End Function

دانلود

کلمات کلیدی : وی بی 6، سورس کد، بدست آوردن ایام هفته

نوشته شده توسط مهدی در چهارشنبه 88/9/25 و ساعت 4:18 عصر | نظرات دیگران()

لیست پروسس های در حال اجرا

با سلام

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

که کاربر می تونه هر کدوم از اونها رو انتخاب کنه و اون پروسس رو ببنده

امیدوارم خوشتون بیاد

نظر فراموش نشه

دانلود

کلمات کلیدی : وی بی 6، لیست پروسس های در حال اجرا

نوشته شده توسط مهدی در چهارشنبه 88/9/4 و ساعت 4:0 صبح | نظرات دیگران()

نرم افزار Flash SafeRemove

یه نرم افزار تهیه کردم به اسم Flash SafeRemove ، همونطور که از اسمش پیداست کارش مدیریت فلش مموری و رم ریدر هست.

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

ادامه مطلب...

کلمات کلیدی : نرم افزار Flash SafeRemove، eject usb drive with vb6، vb6 and usb

نوشته شده توسط مهدی در چهارشنبه 88/8/27 و ساعت 2:3 عصر | نظرات دیگران()

deltree در وی بی 6

این تابع کارش حذف فولدر با تمام محتویاتش هست که در واقع کار دستور deltree رو انجام میده:

Function DelTree(ByVal strDir As String) As Long
Dim x As Long
Dim intAttr As Integer
Dim strAllDirs As String
Dim strFile As String
DelTree = -1
On Error Resume Next
strDir = Trim$(strDir)
If Len(strDir) = 0 Then Exit Function
If Right$(strDir, 1) = "\" Then strDir = Left$(strDir, Len(strDir) - 1)
If InStr(strDir, "\") = 0 Then Exit Function
intAttr = GetAttr(strDir)
If (intAttr And vbDirectory) = 0 Then Exit Function
strFile = Dir$(strDir & "\*.*", vbSystem Or vbDirectory Or vbHidden)
Do While Len(strFile)
If strFile <> "." And strFile <> ".." Then
intAttr = GetAttr(strDir & "\" & strFile)
If (intAttr And vbDirectory) Then
   strAllDirs = strAllDirs & strFile & Chr$(0)
Else
   If intAttr <> vbNormal Then
    SetAttr strDir & "\" & strFile, vbNormal
    If Err Then DelTree = Err: Exit Function
   End If
   Kill strDir & "\" & strFile
   If Err Then DelTree = Err: Exit Function
End If
End If
strFile = Dir$
Loop
Do While Len(strAllDirs)
x = InStr(strAllDirs, Chr$(0))
strFile = Left$(strAllDirs, x - 1)
strAllDirs = Mid$(strAllDirs, x + 1)
x = DelTree(strDir & "\" & strFile)
If x Then DelTree = x: Exit Function
Loop
RmDir strDir
If Err Then
DelTree = Err
Else
DelTree = 0
End If
End Function

کلمات کلیدی : deltree in vb6

نوشته شده توسط مهدی در چهارشنبه 88/8/27 و ساعت 1:47 عصر | نظرات دیگران()

ساخت Shortcut روی دسکتاپ بوسیله اسکریپت

یه تابع براتون میذارم که بوسیله اون می تونید به راحتی بر روی دسکتاپ از هر برنامه ای میانبر بسازید:

Public Sub CreateShortCut_Desktop(Target As String, LinkName As String, Deion As String, Optional Hotkey As String = "", Optional Argument As String = "")
Dim WshShell, oShellLink
Set WshShell = Create("W.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
a1 = InStrRev(Target, "\")
a2 = Mid(Target, 1, Val(a1) - 1)
Set oShellLink = WshShell.CreateShortcut(strDesktop & "\" & LinkName & ".lnk")
oShellLink.TargetPath = Target
oShellLink.WindowStyle = 1
oShellLink.Hotkey = Hotkey
oShellLink.Deion = Deion
oShellLink.Arguments = Argument
oShellLink.WorkingDirectory = a2
oShellLink.Save
End Sub

کلمات کلیدی : VB6، ساخت Shortcut روی دسکتاپ بوسیله اسکریپت

نوشته شده توسط مهدی در چهارشنبه 88/8/27 و ساعت 1:46 عصر | نظرات دیگران()

استفاده از تابع Environ

با استفاده از تابع Environ می تونید به راحتی به یک سری از مشخصات سیستم دست پیدا کنید که برای نمونه چندتا از اونها رو براتون ذکر می کنم:

Environ ("TEMP")
Environ ("TMP")
Environ ("windir")
Environ ("OS")
Environ ("PROCESSOR_IDENTIFIER")

خط اول آدرس شاخه temp رو برمی گردونه، خط دوم ادرس شاخه tmp ، خط سوم آدرس شاخه ویندوز

خط چهارم نوع ویندوز، خط پنجم مدل CPU

کلمات کلیدی : استفاده از تابع Environ

نوشته شده توسط مهدی در چهارشنبه 88/8/27 و ساعت 1:43 عصر | نظرات دیگران()

اجرای برنامه به تعداد مشخص

برای اینکه برناممون به دفعات مشخصی اجرا بشه و بعد از اون از کار بیفته روشهای زیادی هست که معمولا بهترین روش استفاده از برنامه های AntiCrack و یا Packer ها می باشد (من شخصا از expressor استفاده میکنم)

ولی با استفاده از خود وی بی معمولا شما اطلاعات اجرای برنامه رو داخل یک فایل و یا درون رجیستری ذخیره می کنید و با هر بار اجرای برنامه اون رو چک می کنید. یکی از ساده ترین روشها استفاده از SaveSetting وی بی می باشد. نمونه برنامه ای براتون میذارم که فقط 3 بار اجرا میشه و بعد از اون پیغام خطا میده.

Private Sub Form_Load()
res = GetSetting("MyApp", "Setting", "RunCount", "1")
If Val(res) > 3 Then
MsgBox "The Programe has expired.", vbCritical
End
Else
SaveSetting "MyApp", "Setting", "RunCount", Str(Val(res) + 1)
End If
End Sub

کلمات کلیدی : اجرای برنامه به تعداد مشخص در وی بی 6

نوشته شده توسط مهدی در چهارشنبه 88/8/27 و ساعت 1:38 عصر | نظرات دیگران()

اطلاع از نصب برنامه های آفیس

برای اینکه بتونید بفهمید آفیس روی سیستم نصب شده یا نه؟

یک پروژه جدید باز کنید، یک command و چهارتا label به فرمتون اضافه کنید. و کد زیر را داخل قسمت کدنویسی فرمتون اضافه کنید:

Option Explicit
Private Declare Function RegOpenKey Lib _
"advapi32" Alias "RegOpenKeyA" (ByVal hKey _
As Long, ByVal lpSubKey As String, _
phkResult As Long) As Long

Private Declare Function RegQueryValueEx _
Lib "advapi32" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As _
String, lpReserved As Long, lptype As _
Long, lpData As Any, lpcbData As Long) _
As Long

Private Declare Function RegCloseKey& Lib _
"advapi32" (ByVal hKey&)

Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const ERROR_SUCCESS = 0
Private Const HKEY_CLASSES_ROOT = &H80000000

Public Function GetRegString(hKey As Long, _
strSubKey As String, strValueName As _
String) As String
Dim strSetting As String
Dim lngDataLen As Long
Dim lngRes As Long
If RegOpenKey(hKey, strSubKey, _
lngRes) = ERROR_SUCCESS Then
   strSetting = Space(255)
   lngDataLen = Len(strSetting)
   If RegQueryValueEx(lngRes, _
   strValueName, ByVal 0, _
   REG_EXPAND_SZ, ByVal strSetting, _
   lngDataLen) = ERROR_SUCCESS Then
      If lngDataLen > 1 Then
      GetRegString = Left(strSetting, lngDataLen - 1)
   End If
End If

If RegCloseKey(lngRes) <> ERROR_SUCCESS Then
MsgBox "RegCloseKey Failed: " & _
strSubKey, vbCritical
End If
End If
End Function

Function FileExists(sFileName$) As Boolean
On Error Resume Next
FileExists = IIf(Dir(Trim(sFileName)) <> "", _
True, False)
End Function

Public Function IsAppPresent(strSubKey$, _
strValueName$) As Boolean
IsAppPresent = CBool(Len(GetRegString(HKEY_CLASSES_ROOT, _
strSubKey, strValueName)))
End Function

Private Sub Command1_Click()

Label1.Caption = "Access " & _
IsAppPresent("Access.Database\CurVer", "")

Label2.Caption = "Excel " & _
IsAppPresent("Excel.Sheet\CurVer", "")

Label3.Caption = "PowerPoint " & _
IsAppPresent("PowerPoint.Slide\CurVer", "")

Label4.Caption = "Word " & _
IsAppPresent("Word.Document\CurVer", "")

End Sub

کلمات کلیدی : تشخیص نصب آفیس روی سیستم با وی بی

نوشته شده توسط مهدی در چهارشنبه 88/8/27 و ساعت 1:33 عصر | نظرات دیگران()

1 2 >

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