اضافه نمودن هر نوع فایل به پروژه

- با این روش شما به راحتی می تونید هر نوع فایلی رو که مد نظرتون هست به برنامتون اضافه کنید (مثل فونت یا کامپوننت) و در صورت نبودن اون فایل بر روی سیستم ، برنامتون فایل رو روی سیستم ایجاد کنه

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

روش کار به این شکله که شما فایل مورد نظر خودتون رو در بخش resource به پروژتون اضافه می کنید و با استفاده از تابع زیر اون فایل رو در آدرس دلخواهتون ایجاد می کنید:

Public Sub LoadDataIntoFile(DataName As Integer, FileName As String)
    Dim myArray() As Byte
    Dim myFile As Long
    If Dir(FileName) = "" Then
        myArray = LoadResData(DataName, "CUSTOM")
        myFile = FreeFile
        Open FileName For Binary Access Write As #myFile
        Put #myFile, , myArray
        Close #myFile
    End If
End Sub

یه نمونه برنامه براتون میذارم تا بهتر متوجه بشین

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

نوشته شده توسط مهدی در دوشنبه 88/4/15 و ساعت 8:14 عصر | نظرات دیگران()

با سلام و تبریک میلاد حضرت علی (ع)

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

کد زیر را داخل یک ماژول ذخیره کنید:

Private Type ULARGE_INTEGER
  LowPart As Long
  HighPart As Long
End Type
Private Type SHQUERYRBINFO
  cbSize As Long
  i64Size As ULARGE_INTEGER
  i64NumItems As ULARGE_INTEGER
End Type
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 = &H1
Private Declare Function SHQueryRecycleBin Lib "shell32.dll" Alias "SHQueryRecycleBinA" (ByVal pszRootPath As String, pSHQueryRBInfo As SHQUERYRBINFO) As Long
Private Declare Function StrFormatByteSize Lib "shlwapi" Alias "StrFormatByteSizeA" (ByVal dw As Long, ByVal pszBuf As String, ByRef cchBuf As Long) As String
   
Function Get_Empty_Recyclebin()
 retvaL = SHEmptyRecycleBin(1, "", SHERB_NOPROGRESSUI)
End Function

Function Get_Recyclebin_size()
Dim RBinInfo As SHQUERYRBINFO
 RBinInfo.cbSize = Len(RBinInfo)
 SHQueryRecycleBin vbNullString, RBinInfo
 Get_Recyclebin_size = FormatKB(RBinInfo.i64Size.LowPart)
End Function

Function Get_Recyclebin_Items()
Const RECYCLE_BIN = &HA&
Dim a As Shell32.Folder "Required: References> Microsoft Shell Controls And Automation
 Set objShell = Create("Shell.Application")
 Set a = objShell.NameSpace(RECYCLE_BIN)
 Get_Recyclebin_Items = a.Items.Count
End Function

Public Function FormatKB(ByVal Amount As Long) As String
Dim Buffer As String
Dim Result As String
 Buffer = Space$(255)
 Result = StrFormatByteSize(Amount, Buffer, Len(Buffer))
 If InStr(Result, vbNullChar) > 1 Then
   FormatKB = Left$(Result, InStr(Result, vbNullChar) - 1)
 End If
End Function

-اطلاع از حجم سطل زباله با Get_Recyclebin_size

-اطلاع از تعداد فایلهای موجود در سطل زباله با Get_Recyclebin_Items

-حذف محتویات سطل زباله با Get_Empty_Recyclebin

دانلود نمونه برنامه

نوشته شده توسط مهدی در دوشنبه 88/4/15 و ساعت 8:5 عصر | نظرات دیگران()

برای ایجاد فرم شیشه ای یا همون ترانسپرنت کد زیر رو داخل یک ماژول ذخیره کنید و از اون داخل برنامتون استفاده کنید

Public Const WS_EX_LAYERED As Long = &H80000
Public Const LWA_ALPHA As Long = &H2
Public Const GWL_EXSTYLE = (-20)
Public Const RDW_INVALIDATE = &H1
Public Const RDW_ERASE = &H4
Public Const RDW_ALLCHILDREN = &H80
Public Const RDW_FRAME = &H400

Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function RedrawWindow2 Lib "user32" Alias "RedrawWindow" (ByVal hwnd As Long, ByVal lprcUpdate As Long, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long

Private Type OSVersionInfo
    OSVSize       As Long
    dwVerMajor    As Long
    dwVerMinor    As Long
    dwBuildNumber As Long
    PlatformID    As Long
    szCSDVersion  As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
    (lpVersionInformation As OSVersionInfo) As Long

Sub Make_Transparent(lHwnd As Long, Porcentaje As Integer)
 On Error GoTo Hell

 
  Dim OSV As OSVersionInfo
   
  OSV.OSVSize = Len(OSV)
  If GetVersionEx(OSV) <> 1 Then Exit Sub
      
  If OSV.PlatformID = 1 And OSV.dwVerMinor >= 10 Then Exit Sub
  If OSV.PlatformID = 2 And OSV.dwVerMajor >= 5 Then
    Call SetWindowLong(lHwnd, GWL_EXSTYLE, GetWindowLong(lHwnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
    Call SetLayeredWindowAttributes(lHwnd, 0, (Porcentaje * 255) / 100, LWA_ALPHA)
  End If
Exit Sub
Hell:
End Sub

دانلود نمونه برنامه

از این شیوه میشه در افکت دادن به فرم هنگام Load یا UnLoad استفاده کرد

دانلود نمونه برنامه

نوشته شده توسط مهدی در جمعه 88/4/12 و ساعت 6:29 صبح | نظرات دیگران()

برای اضافه نمودن تصویر به منوی برنامه می تونید از این ماژول استفاده کنید

این کار به راحتی صورت می گیره و شکل زیبایی رو به برنامتون میده

برای استفاده به ادامه مطلب مراجعه کنید

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

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

نوشته شده توسط مهدی در دوشنبه 88/4/1 و ساعت 10:14 عصر | نظرات دیگران()

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

نمونه این دستور به شکل زیر می باشد (فایل مورد نظر: اسم برنامه shell)

Private Sub Command1_Click()
    Shell "Mspaint E:\Love.bmp"
End Sub

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

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Declare Function CreateProcess Lib "kernel32" _
Alias "CreateProcessA" _
(ByVal lpApplicationName As String, _
ByVal lpCommandLine As String, _
lpProcessAttributes As Any, _
lpThreadAttributes As Any, _
ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, _
lpEnvironment As Any, _
ByVal lpCurrentDriectory As String, _
lpStartupInfo As STARTUPINFO, _
lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" _
(ByVal dwAccess As Long, _
ByVal fInherit As Integer, _
ByVal h As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" _
(ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal h As Long) As Long
Const SYNCHRONIZE = 1048576
Const NORMAL_PRIORITY_CLASS = &H20&

Private Sub Form_Click()
Dim pInfo As PROCESS_INFORMATION
Dim sInfo As STARTUPINFO
Dim sNull As String
Dim lSuccess As Long
Dim lRetValue As Long
sInfo.cb = Len(sInfo)
lSuccess = CreateProcess(sNull, "Calc.exe", _
ByVal 0&, ByVal 0&, 1&, _
NORMAL_PRIORITY_CLASS, ByVal 0&, sNull, sInfo, pInfo)
MsgBox "Calculator has been launched!"
lRetValue = TerminateProcess(pInfo.hProcess, 0&)
lRetValue = CloseHandle(pInfo.hThread)
lRetValue = CloseHandle(pInfo.hProcess)
MsgBox "Calculator has terminated!"
End Sub

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

Public 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

"Exampel  Call Shell2("c:\temp\a.exe")

Function Shell2(Program As String, Optional ShowCmd As Long = _
vbNormalNoFocus, Optional ByVal WorkDir As Variant) As Long

    Dim FirstSpace As Integer, Slash As Integer

    If Left(Program, 1) = """" Then
        FirstSpace = InStr(2, Program, """")

        If FirstSpace <> 0 Then
            Program = Mid(Program, 2, FirstSpace - 2) & _
              Mid(Program, FirstSpace + 1)
            FirstSpace = FirstSpace - 1
        End If

    Else
        FirstSpace = InStr(Program, " ")
    End If

    If FirstSpace = 0 Then FirstSpace = Len(Program) + 1

    If IsMissing(WorkDir) Then

        For Slash = FirstSpace - 1 To 1 Step -1
            If Mid(Program, Slash, 1) = "\" Then Exit For
        Next

        If Slash = 0 Then
            WorkDir = CurDir
        ElseIf Slash = 1 Or Mid(Program, Slash - 1, 1) = ":" Then
            WorkDir = Left(Program, Slash)
        Else
            WorkDir = Left(Program, Slash - 1)
        End If

    End If

    Shell2 = ShellExecute(0, vbNullString, _
    Left(Program, FirstSpace - 1), LTrim(Mid(Program, _
    FirstSpace)), WorkDir, ShowCmd)
    If Shell2 < 32 Then VBA.Shell Program, ShowCmd "To raise Error

End Function

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

Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long

dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
Private Declare Function WaitForSingle Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal h As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&

Public Function ExecCmd(cmdline$)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
" Initialize the STARTUPINFO structure:
start.cb = Len(start)
" Start the shelled application:
ret& = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)
" Wait for the shelled application to finish:
ret& = WaitForSingle(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function

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

برنامه ای که قصد معرفی اون رو دارم  VB AntiCrack هست که محصول شرکت GPcH Soft می باشد

این برنامه کلیه رشته های موجود در پروژه وی بی را تبدیل به مجموعه ای از کاراکترها می کند که کرک برنامه را مشکل می نماید

VB AntiCrack is used to make it more difficult to crack your programs written in Visual Basic 6.0. Most crackers will not be able to crack your program because they will not find a single text strings in your EXE file, which will make searching for the code they need much more complicated. As you can guess, it makes sense to use this program only if your program is not freeware and has a time limitation or password protection, which makes it interesting for those who crack software protection.

شما می توانید برنامه را از آدرس زیر دانلود کنید:

http://www.gpchsoft.com/vb_anticrack.htm

این هم یوزر و پسورد برنامه:

NamE : Pharaohs Come Team

 CodE : F981-0693-F96F-0690

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

نوشته شده توسط مهدی در چهارشنبه 88/3/13 و ساعت 5:41 صبح | نظرات دیگران()

اینم یه برنامه کامل برای تغییر عکس پس زمینه که با وی بی نوشتم

امیدوارم به کارتون بیاد

لطفا نظر فراموش نشه.

نوشته شده توسط مهدی در سه شنبه 88/3/5 و ساعت 5:22 صبح | نظرات دیگران()