Bilgisayarı kapatma kodu:
'Bir module yaratın ve aşağıdaki kodları yapıştırın
Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long)
Public Const ZorlaKapat = 4
Public Const LOGOFF = 0
Public Const KapatAc = 2
Public Const Kapat = 1
kullanımı: Call ExitWindowsEx(Kapat, 0)
Dosya türünü bulan fonksiyon:
Private Function dosyaturu(ByVal dosyaadi As String) As String
Dim i As Integer
Dim xstr, xout As String
For i = 1 To Len(dosyaadi)
xstr = Mid(dosyaadi, Len(dosyaadi) - i + 1, 1)
If xstr <> "." Then xout = xout & xstr Else Exit For
Next i
For i = 1 To Len(xout)
xstr = Mid(xout, Len(xout) - i + 1, 1)
dosyaturu = dosyaturu & xstr
Next i
End Function
Kullanımı: MsgBox dosyaturu("C:\windows\system.ini")
Temp Klasörünü bulan fonksiyon:
Private Const MAX_PATH = 260
Private Declare Function apiGetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Public Function GetTempPath() As String
Dim sBuffer As String, lSize As Long
sBuffer = String(260, vbNullChar)
lSize = apiGetTempPath(Len(sBuffer) - 1, sBuffer)
If lSize Then
GetTempPath = Left(sBuffer, lSize)
Else
GetTempPath = vbNullString
End If
End Function
Kullanımı: MsgBox GetTempPath
Harddiskin seri no sunu alma
Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long
Function SeriNoAl(strDrive As String) As Long
Dim SerialNum As Long
Dim Res As Long
Dim Temp1 As String
Dim Temp2 As String
Temp1 = String$(255, Chr$(0))
Temp2 = String$(255, Chr$(0))
Res = GetVolumeInformation(strDrive, Temp1, _
Len(Temp1), SerialNum, 0, 0, Temp2, Len(Temp2))
SeriNoAl = SerialNum
End Function
Kullanımı: MsgBox SeriNoAl("c:\")
Formun herhangi bir yerinden tutup sürükleyebilme özelliği:
Option Explicit
Private Declare Function ReleaseCapture Lib "user32" () As Long
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
Private Const HTCAPTION = 2
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const WM_SYSCOMMAND = &H112
Private Sub Form_MouseDown(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
Call ReleaseCapture
SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
End Sub
Saydam form oluşturma:
Önce Modül oluşturun ve içine aşağıdaki kodu kopyalayın.
Public Declare Function GetWindowLong Lib "User32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "User32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function SetLayeredWindowAttributes Lib "User32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function SetLayeredAttributes Lib "User32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function UpdateLayeredWindow Lib "User32.dll" (ByVal hWnd As Long, ByVal hdcDst As Long, pptDst As Any, psize As Any, ByVal hdcSrc As Long, pptSrc As Any, crKey As Long, ByVal pblend As Long, ByVal dwFlags As Long) As Long
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const ULW_COLORKEY = &H1
Public Const ULW_ALPHA = &H2
Public Const ULW_OPAQUE = &H4
Public Const AC_SRC_OVER = &H0
Public Const AC_SRC_ALPHA = &H1
Public Const AC_SRC_NO_PREMULT_ALPHA = &H1
Public Const AC_SRC_NO_ALPHA = &H2
Public Const AC_DST_NO_PREMULT_ALPHA = &H10
Public Const AC_DST_NO_ALPHA = &H20
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
Public Sub MakeTransparent(hWnd, Rate)
Dim WinInfo As Long
On Local Error Resume Next
WinInfo = GetWindowLong(hWnd, GWL_EXSTYLE)
WinInfo = WinInfo Or WS_EX_LAYERED
On Local Error Resume Next
SetWindowLong hWnd, GWL_EXSTYLE, WinInfo
On Local Error Resume Next
SetLayeredWindowAttributes hWnd, 0, Rate, LWA_ALPHA
End Sub
Sonra Form1 modülüne aşağıdaki kodu yapıştırın
Private Sub Form_Load()
MakeTransparent Me.hWnd, 200
Me.Show
End Sub
Konu: Kodlama arşivi 
C.tesi Haz. 07, 2008 4:46 pm
