Lập trình Visual Basic với các chiêu thức

Lập trình Visual Basic với chiêu thức sẽ giới thiệu đến bạn 27 độc chiêu giúp bạn lập trình Visual Basic hiệu quả. Mong rằng thông qua quyển sách này có thể giúp ích cho bạn trong việc lập trình.

Tác giả : Lê Nguyên Dũng Lớp 11C1 trường THPT Đăk Nông (Thị xã Gia Nghĩa - Đ ăk Nông) Email : le.nguyendung@gmail.com Nick : nguyen_dung_vb Địa nhà : Thôn 1, thị trấn Đăk Mâm Huyện Krông Nô Tỉnh Đắk Nông Tự hào ghê Logo sách thiết kế Word Paint Nhìn vơ chun nghiệp Lời nói đầu Sau “Xuất bản” “Chiêu thức lập trình” thật buồn chẳng có lấy lời động viên từ (Ở Đăk Nông có biết mà khoe) cịn anh em việt nam nét chẳng đối hồi thật nản, để cuối sau cố nghề nghiệp phiên Chiêu thức lập trình phiên viết gần hồn thành tan vào sương khói tuyệt vọng Nhưng hồi sáng “Viếng” www.caulacbovb.com diễn đàn tham gia từ lâu khơng quan tâm thấy sách chia đó, với lời khen nhân vật khơng nhớ tên làm vui, nhận cơng nhận dù chút Cuốn Chiêu thức lập trình lần nâng cấp lên với nhiều chiêu thức hình vẽ minh hoạ để giúp bạn nâng cao kiến thức Lời cầu cứu : Do từ năm lớp đến tập trung vào học lập trình (Mà lại tồn tự học) nên đệ học sút nhiều nguy rớt đại học ngày đến gần mà ước mơ lớn đời đệ đậu vào khoa Công Nghệ Thơng Tin Đại học Bách Khoa Hồ Chí Minh đệ mong có huynh phải nếm trải cảnh thi đại học chia sẻ kinh nghiệm học, học sách Cịn có sách (Cũ được) không cần dùng tới tốt để ôn thi đại học chia cho đệ Nếu có huynh có lịng “Hảo tâm” gửi đến địa : (Đây địa cô giáo dạy Tin trường đệ vào hết năm học thay đổi) Phạm Thị Loan giáo viên trường Trung Học Phổ Thông Đăk Nông, xin ghi rõ nhở gửi cho em Lê Nguyên Dũng lớp 11C1 Cuốn sách sách hồn tồn miễn phí để chia cộng đồng lập trình nên có múơn sử dụng để in sách nên ghi rõ xuất sứ Trong sách xin rõ xuất xứ, mong ban tôn tác giả không chỉnh sửa tác giả hay xuất xứ Cuốn sách theo định hướng sử dụng hàm API lệnh đơn giản để tạo thành thủ thuật hạn chế tối đa phải sử dụng công cụ hỗ trợ Mục lục Đôc chiêu c : “Thả câu từ trrên cao xuống” (Có thể ói vậy) Đơc chiêu c : Hiện câu bằn ng cách lần lư ượt chữ Đôc chiêu c : Hiện trỏ động g đối tư ượng Đơc chiêu c : Form m có hình dạn ng theo hìình ảnh bất k ỳ Đơc chiêu c : “Chụ ụp ảnh hìình vào Picture” P Đôc chiêu c : “Vô hiệu h hoá butto on close menu m form m (cả Alt-F4 lu uôn)” Đôc chiêu c : “Kéo o form di chuyyển từ điể ểm bất kỳ” Đôc chiêu c : “Ghi lại tất nhữ ững phím gõ tên t bàn phím”” Đơc chiêu c : Đóng g ứng dụng Đơc chiêu c 10 : Tạo o phím nóng cho c chương trình t Đơc chiêu c 11 : Tha ay đổi hình nề ền cho Deskto op Đơc chiêu c 12 : Đón ng mở khay CD-ROM C Đơc chiêu c 13 : Tạo o System mTray cho ứng g dụng bạ ạn Đôc chiêu c 14 : Tha ay đổi Font tiế ếng việt cho Menu M Win ndow Đôc chiêu c 15 : So sánh hai ảnh Đôc chiêu c 16 : Liệtt kê danh sácch thành phần p phần ứng máyy Đơc chiêu c 17 : Chư ương trình kh hởi động g với Window wns Đôc chiêu c 18 : Play y file nhạ ạc Midi Đôc chiêu c 19 : Kho oá file ảnh định dạng bmp Đôc chiêu c 20 : Để form bạn n chế độ “Lu uôn nổi” Đôc chiêu c 21 : Tex xtBox “Chịịu” nhận số Đôc chiêu c 22 : Để form trở nên suốt Đôc chiêu c 23 : Lấy y tên người sử dung Windowns W Đôc chiêu c 24 : Ché ép hìn nh làm việc vào Picturre Đôc chiêu c 25 : Dấu u liệu dạng g text vào fiile Đôc chiêu c 26 :Mở hộp thoạ ại Control Panel Đ chiêu 27 : Mã hoá liệu dạng textt Đôc Đôc chiêu : “Thả câu từ cao xuống” (Có thể nói vậy) home Xuất xứ : www.pscode.com Binh khí sử dụng : Một Picture CommandButton Đoạn mã : Option Explicit Private Sub command1_Click() Randomize Timer 'Declarations Dim StartTime(100) movement Dim DownMovement(100) As Boolean movement ??? Dim MoveDistance As Double since the start of the movement Dim YPos(100) As Double letter Dim MovementDone(100) As Boolean down movement is completed Dim StartHeight(100) As Double the letter fall down ? Dim UpMovementTime(100) As Double letter take to move up Dim PowerLoss(100) As Double when touching the ground Dim Message As String display Dim Looop As Integer Dim TextColor(100) As ColorConstants 'Init Rnd 'Starttime of a up/down 'are we doing a up or down 'distance target has moved 'Holds the y position of a 'Is set to true when a up / 'From which hight will 'How long will it the 'losing xx% of power 'Message you want to 'Loop var 'Color of one letter 'Settings picture1.ScaleMode = picture1.FontName = "Courier New" Message = "Ohh my god ! It's raining letters today !!! Contact me: overkillpage@gmx.net" 'Message you want to display For Looop = To Len(Message) PowerLoss(Looop) = 0.2 + ((Rnd * 25) / 100) 'losing xx% of power when touching the ground StartHeight(Looop) = TextColor(Looop) = RGB(80 + Looop * 2, 80 + Looop * 2, 255) Next Looop For Looop = To Len(Message) StartTime(Looop) = Timer 'Setting up startime for a following movement, needed for calculation of position Next Looop Do picture1.Cls 'Clear picturebox 'Looping throung the textmessage For Looop = To Len(Message) If DownMovement(Looop) = True Then MoveDistance = (StartHeight(Looop) + (0.5 * 9.81 * ((Timer - StartTime(Looop)) ^ 2))) 'Calculating falling distance If YPos(Looop) >= picture1.ScaleHeight - Then MovementDone(Looop) = True 'The letter reached the bottom border The Downmovement is complete Else MoveDistance = (StartHeight(Looop) + (0.5 * 9.81 * (UpMovementTime(Looop) - (Timer - StartTime(Looop))) ^ 2)) 'Calculating falling distance If YPos(Looop) Then TrimStr = Left(strName, x - 1) Else TrimStr = strName End Function Public Function LPSTRtoSTRING(ByVal lngPointer As Long) As String Dim lngLength As Long lngLength = lstrlenW(lngPointer) * LPSTRtoSTRING = String(lngLength, 0) CopyMem ByVal StrPtr(LPSTRtoSTRING), ByVal lngPointer, lngLength LPSTRtoSTRING = TrimStr(StrConv(LPSTRtoSTRING, vbUnicode)) End Function Public Function GetAvailablePorts(ServerName As String) As Long Dim ret As Long Dim PortsStruct(0 To 100) As API_PORT_INFO_2 Dim pcbNeeded As Long Dim pcReturned As Long Dim TempBuff As Long Dim i As Integer ret = EnumPorts(ServerName, 2, TempBuff, 0, pcbNeeded, pcReturned) TempBuff = HeapAlloc(GetProcessHeap(), 0, pcbNeeded) ret = EnumPorts(ServerName, 2, TempBuff, pcbNeeded, pcbNeeded, pcReturned) If ret Then CopyMem PortsStruct(0), ByVal TempBuff, pcbNeeded For i = To pcReturned - Ports(i).pDescription = LPSTRtoSTRING(PortsStruct(i).pDescription) Ports(i).pPortName = LPSTRtoSTRING(PortsStruct(i).pPortName) Ports(i).pMonitorName = LPSTRtoSTRING(PortsStruct(i).pMonitorName) Ports(i).fPortType = PortsStruct(i).fPortType Next End If GetAvailablePorts = pcReturned If TempBuff Then HeapFree GetProcessHeap(), 0, TempBuff End Function Private Sub Lay_Ports() Dim NumPorts As Long Dim i As Integer NumPorts = GetAvailablePorts("") Me.Print "Daùnh sách Port tại" For i = To NumPorts - Me.Print Ports(i).pPortName Next End Sub '*********************************************************************' Thôngt tin tình trạng mạng thơng số card mạng Private Sub Lay_Adepter() Dim error As Long Dim FixedInfoSize As Long Dim AdapterInfoSize As Long Dim i As Integer Dim PhysicalAddress As String Dim NewTime As Date Dim AdapterInfo As IP_ADAPTER_INFO Dim Adapt As IP_ADAPTER_INFO Dim AddrStr As IP_ADDR_STRING Dim FixedInfo As FIXED_INFO Dim Buffer As IP_ADDR_STRING Dim pAddrStr As Long Dim pAdapt As Long Dim Buffer2 As IP_ADAPTER_INFO Dim FixedInfoBuffer() As Byte Dim AdapterInfoBuffer() As Byte FixedInfoSize = error = GetNetworkParams(ByVal 0&, FixedInfoSize) If error Then If error ERROR_BUFFER_OVERFLOW Then Me.Print "GetNetworkParams sizing failed with error " & error Exit Sub End If End If ReDim FixedInfoBuffer(FixedInfoSize - 1) error = GetNetworkParams(FixedInfoBuffer(0), FixedInfoSize) If error = Then CopyMemory FixedInfo, FixedInfoBuffer(0), Len(FixedInfo) Me.Print "Host Name: " & FixedInfo.HostName 'host name Me.Print "DNS Servers: " & FixedInfo.DnsServerList.IpAddress 'dns server IP pAddrStr = FixedInfo.DnsServerList.Next Do While pAddrStr CopyMemory Buffer, ByVal pAddrStr, Len(Buffer) Me.Print "DNS Servers: " & Buffer.IpAddress 'dns server IP pAddrStr = Buffer.Next Loop Select Case FixedInfo.NodeType 'node type Case Me.Print "Node type: Broadcast" Case Me.Print "Node type: Peer to peer" Case Me.Print "Node type: Mixed" Case Me.Print "Node type: Hybrid" Case Else Me.Print "Unknown node type" End Select Me.Print "NetBIOS Scope ID: " & FixedInfo.ScopeId 'scope ID 'routing If FixedInfo.EnableRouting Then Me.Print "IP Routing Enabled " Else Me.Print "IP Routing not enabled" End If ' proxy If FixedInfo.EnableProxy Then Me.Print "WINS Proxy Enabled " Else Me.Print "WINS Proxy not Enabled " End If ' netbios If FixedInfo.EnableDns Then Me.Print "NetBIOS Resolution Uses DNS " Else Me.Print "NetBIOS Resolution Does not use DNS " End If Else Me.Print "GetNetworkParams failed with error " & error Exit Sub End If AdapterInfoSize = error = GetAdaptersInfo(ByVal 0&, AdapterInfoSize) If error Then If error ERROR_BUFFER_OVERFLOW Then Me.Print "GetAdaptersInfo sizing failed with error " & error Exit Sub End If End If ReDim AdapterInfoBuffer(AdapterInfoSize - 1) error = GetAdaptersInfo(AdapterInfoBuffer(0), AdapterInfoSize) If error Then Me.Print "GetAdaptersInfo failed with error " & error Exit Sub End If CopyMemory AdapterInfo, AdapterInfoBuffer(0), Len(AdapterInfo) pAdapt = AdapterInfo.Next Do While pAdapt CopyMemory Buffer2, AdapterInfo, Len(Buffer2) Select Case Buffer2.Type Case MIB_IF_TYPE_ETHERNET Me.Print "Ethernet adapter " Case MIB_IF_TYPE_TOKENRING Me.Print "Token Ring adapter " Case MIB_IF_TYPE_FDDI Me.Print "FDDI adapter " Case MIB_IF_TYPE_PPP Me.Print "PPP adapter" Case MIB_IF_TYPE_LOOPBACK Me.Print "Loopback adapter " Case MIB_IF_TYPE_SLIP Me.Print "Slip adapter " Case Else Me.Print "Other adapter " End Select Me.Print " AdapterName: " & Buffer2.AdapterName Me.Print "AdapterDescription: " & Buffer2.Description 'adatpter name For i = To Buffer2.AddressLength - PhysicalAddress = PhysicalAddress & Hex(Buffer2.Address(i)) If i < Buffer2.AddressLength - Then PhysicalAddress = PhysicalAddress & "-" End If Next Me.Print "Physical Address: " & PhysicalAddress 'mac address If Buffer2.DhcpEnabled Then Me.Print "DHCP Enabled " Else Me.Print "DHCP disabled" End If pAddrStr = Buffer2.IpAddressList.Next Do While pAddrStr CopyMemory Buffer, Buffer2.IpAddressList, LenB(Buffer) Me.Print "IP Address: " & Buffer.IpAddress Me.Print "Subnet Mask: " & Buffer.IpMask pAddrStr = Buffer.Next If pAddrStr Then CopyMemory Buffer2.IpAddressList, ByVal pAddrStr, Len(Buffer2.IpAddressList) End If Loop Me.Print "Default Gateway: " & Buffer2.GatewayList.IpAddress pAddrStr = Buffer2.GatewayList.Next Do While pAddrStr CopyMemory Buffer, Buffer2.GatewayList, Len(Buffer) Me.Print "IP Address: " & Buffer.IpAddress pAddrStr = Buffer.Next If pAddrStr Then CopyMemory Buffer2.GatewayList, ByVal pAddrStr, Len(Buffer2.GatewayList) End If Loop Me.Print "DHCP Server: " & Buffer2.DhcpServer.IpAddress Me.Print "Primary WINS Server: " & Buffer2.PrimaryWinsServer.IpAddress Me.Print "Secondary WINS Server: " & Buffer2.SecondaryWinsServer.IpAddress NewTime = CDate(Adapt.LeaseObtained) Me.Print "Lease Obtained: " & CStr(NewTime) NewTime = CDate(Adapt.LeaseExpires) Me.Print "Lease Expires : " & CStr(NewTime) pAdapt = Buffer2.Next If pAdapt Then CopyMemory AdapterInfo, ByVal pAdapt, Len(AdapterInfo) End If Loop End Sub Private Sub Form_Load() Me.Font = "VNI-Palatin" Me.AutoRedraw = True Ten_Card_ManHinh Ten_Cac_May_In Ban_Phim Lay_CPU Lay_Ports Lay_Adepter End Sub Đôc chiêu 17 : Chương trình khởi động với Windowns home Xuất xứ : www.pscode.com Binh khí sử dụng : Một Module Đoạn mã : Module : Option Public Public Public Public Explicit Const HKEY_CLASSES_ROOT = &H80000000 Const HKEY_LOCAL_MACHINE = &H80000002 Const ERROR_SUCCESS = 0& Const HKEY_CURRENT_USER = &H80000001 Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long 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 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 = ' Unicode nul terminated String Public Function ReplaceChars(ByVal Text As String, ByVal Char As String, ReplaceChar As String) As String Dim counter As Integer counter = Do counter = InStr(counter, Text, Char) If counter Then Mid(Text, counter, Len(ReplaceChar)) = ReplaceChar Else ReplaceChars = Text Exit Do End If Loop ReplaceChars = Text End Function Public Function GetString(hKey As Long, strPath As String, strValue As String, DefaultStr As Long) As String 'EXAMPLE: ' 'text1.text = getstring(HKEY_CURRENT_USE ' R, "Software\VBW\Registry", "String") ' Dim keyhand As Long Dim lResult As Long Dim strBuf As String Dim lDataBufSize As Long Dim intZeroPos As Integer Dim lValueType As Long RegOpenKey hKey, strPath, keyhand lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize) If lValueType = REG_SZ Then strBuf = String(lDataBufSize, " ") lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize) If lResult = ERROR_SUCCESS Then intZeroPos = InStr(strBuf, Chr$(0)) If intZeroPos > Then GetString = Left$(strBuf, intZeroPos - 1) Else GetString = strBuf End If End If End If If strBuf = "" Then GetString = DefaultStr End Function Public Sub SaveString(hKey As Long, strPath As String, strValue As String, strdata As String) Dim keyhand As Long keyhand = RegOpenKey hKey, strPath, keyhand If keyhand = Then RegCreateKey hKey, strPath, keyhand RegSetValueEx keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata) RegCloseKey keyhand End Sub Form : Function Khoidong() If GetSetting("dungcoi", "dung", "Path") App.Path & "\" & App.EXEName & ".exe" Then SaveString HKEY_CLASSES_ROOT, "Folder\shell\Khoi dong Virus\command", "", App.Path & "\" & App.EXEName & ".exe" & " /ADDDRV %1" SaveString HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", "dungcoi", App.Path & "\" & App.EXEName & ".exe" & " /STARTUP" SaveSetting "dungcoi", "dung", "Path", App.Path & "\" & App.EXEName & ".exe" End If End Function Private Sub Form_Load() Khoidong End Sub Đôc chiêu 18 : Play file nhạc Midi home Xuất xứ : Lê Nguyên Dũng (dungcoi2005) sửa lại từ www.allapi.net Binh khí sử dụng : Một Module, nút ấn (CommandButton) Đoạn mã : Module : 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 Form : Private Sub Form_Load() Command1.Caption = "Play" Command2.Caption = "Stop" End Sub Private Sub Command1_Click() result = mciSendString("open d:\Nhac.mid type sequencer alias canyon", 0&, 0, 0) result = mciSendString("play canyon", 0&, 0, 0) End Sub Private Sub Command2_Click() result = mciSendString("close all", 0&, 0, 0) End Sub Đôc chiêu 19 : Khoá file ảnh định dạng bmp home Xuất xứ : Lê Nguyên Dũng (dungcoi2005) sửa lại từ www.pscode.com Binh khí sử dụng : nút ấn (CommandButton) Nói qua : Chiêu hay bạn giúp bạn khơng cho người khác xem ảnh bạn muốn quan trọng bạn dễ dành viết phần mềm bảo mật ảnh Đoạn mã : Function MoKhoa(File) A = FreeFile Open File For Binary As #A B$ = Chr(0) Put #A, 17, B$ Close #A End Function Function KhoaAnh(File) A = FreeFile Open File For Binary As #A B$ = "X" Put #A, 17, B$ Close #A End Function Private Sub Command1_Click() KhoaAnh ("d:\hinh anh.bmp") End Sub Private Sub Command2_Click() MoKhoa ("d:\hinh anh.bmp") End Sub Private Sub Form_Load() Command1.Caption = " Khoa file anh" Command2.Caption = " Mo khoa file anh" End Sub Đôc chiêu 20 : Để form bạn chế độ “Luôn nổi” home Xuất xứ : Lê Nguyên Dũng (dungcoi2005) sửa lại từ www.allapi.net Binh khí sử dụng : Timer có giá trị Interval = 50 gì đừng lớn q chương trình “Nhạy” đừng nhỏ chương trình “Giật giật” Đoạn mã : Const HWND_TOPMOST = -1 Const HWND_NOTOPMOST = -2 Const SWP_NOSIZE = &H1 Const SWP_NOMOVE = &H2 Const SWP_NOACTIVATE = &H10 Const SWP_SHOWWINDOW = &H40 Private Declare Sub 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) Private Sub Timer1_Timer() SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE End Sub Đôc chiêu 21 : TextBox “Chịu” nhận số home Xuất xứ : www.allapi.net Binh khí sử dụng : TextBox Module Đoạn mã : Module Const Number$ = "0123456789." ' Chỉ nhận ký tự Form : Private Sub Text1_KeyPress(KeyAscii As Integer) If IsNumeric(Chr(KeyAscii)) True Then KeyAscii = End Sub Đôc chiêu 22 : Để form trở nên suốt home Xuất xứ : www.allapi.net Binh khí sử dụng : Không Đoạn mã : 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 Private Sub Form_Load() Dim Ret As Long Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE) Ret = Ret Or WS_EX_LAYERED SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret SetLayeredWindowAttributes Me.hWnd, 0, 128, LWA_ALPHA End Sub ‘ Chú ý số 128 : Chính số định độ suốt (Số từ 0->255) Đôc chiêu 23 : Lấy tên người sử dung Windowns home Xuất xứ : www.allapi.net Binh khí sử dụng : Module Đoạn mã : Module : Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long Form : Sub Get_User_Name() Dim lpBuff As String * 25 Dim ret As Long, UserName As String ret = GetUserName(lpBuff, 25) UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1) MsgBox UserName End Sub Private Sub Form_Load() Get_User_Name End Sub Đôc chiêu 24 : Chép hình làm việc vào Picture home Xuất xứ : www.ttvnol.com Binh khí sử dụng : Picture nút ấn Đoạn mã : Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long Private Sub Command1_Click() Dim wScreen As Long Dim hScreen As Long Dim w As Long Dim h As Long Picture1.Cls wScreen = Screen.Width \ Screen.TwipsPerPixelX hScreen = Screen.Height \ Screen.TwipsPerPixelY Picture1.ScaleMode = vbPixels w = Picture1.ScaleWidth h = Picture1.ScaleHeight hdcScreen = GetDC(0) r = StretchBlt(Picture1.hdc, 0, 0, w, h, hdcScreen, 0, 0, wScreen, hScreen, vbSrcCopy) End Sub Đôc chiêu 25 : Dấu liệu dạng text vào file home Xuất xứ : www.ttvnol.com Binh khí sử dụng : Hai textbox đặt tên txtPath txtContains Hai command button đặt tên CmdEncrypt CmdDecrypt Đoạn mã : (Khi Runtime nhớ nhập đường dẫn nội dung) Public Function Dat_Thong_Diep(DuongDan As String, ThongDiep As String) As String Open DuongDan For Binary As #1 Dim BoDem As String BoDem = Space(LOF(1)) Get #1, , BoDem Close #1 Dim Message As String Open DuongDan For Binary As #2 Message = BoDem & ThongDiep & Chr(Len(ThongDiep)) Put #2, , Message End Function Public Function Lay_Thong_Diep(DuongDan As String) As String Open DuongDan For Binary As #1 Dim BoDem As String BoDem = Space(LOF(1)) Get #1, , BoDem Close #1 Dim Message As String Dim LuuC As String LuuC = Right(BoDem, 1) Message = Right(BoDem, Asc(LuuC) + 1) Message = Left(Message, Len(Message) - 1) Lay_Thong_Diep = Message End Function Private Sub CmdEncrypt_Click() If txtPath "" And txtContains "" Then Dat_Thong_Diep Trim$(txtPath), Trim$(txtContains) End If End Sub Private Sub CmdDecrypt_Click() txtContains = "" If txtPath "" Then txtContains = Lay_Thong_Diep(Trim$(txtPath)) End If End Sub Đôc chiêu 26 : Mở hộp thoại Control Panel home Xuất xứ : www.pscode.com Binh khí sử dụng : Khơng Đoạn mã : ( Do có nhiều phần nên tơi đưa Code bản) 'Hộp thoại System Properties Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL @1", 5) ‘Hộp thoại Add/Remove Programs Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1", 5) ' Hộp thoại Date/Time Properties Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL timedate.cpl", 5) ' Hộp thoại Display Properties Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0", 5) ' Hộp thoại Game Controllers Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL ' Hộp thoại Internet Properties Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0", 5) ' Hộp thoại Keyboard Properties Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL @1", 5) ' Hộp thoại Modem Properties Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL 5) ' Hộp thoại Mouse Properties Dim dblReturn As Double sysdm.cpl joy.cpl", 5) main.cpl modem.cpl", dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL main.cpl @0", 5) ' Hộp thoại Multimedia Properties Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl,,0", 5) ' Hộp thoại Network Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl", 5) ' Hộp thoại Regional Settings Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL intl.cpl,,0", 5) ' Hộp thoại Sounds Properties Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl @1", 5) Đơc chiêu 27 : Mã hố liệu dạng text home Nói qua : Phần hay bạn nên ý thực tế ứng dụng nên sử dụng file trung gian để chứa liệu mã hoá Xuất xứ : www.vbcode.com Đây Demo nè, ấn tượng phải không muốn có Source mail cho tơi Binh khí sử dụng : Nút ấn với tên cmdEncode cmdDecode, TextBox với tên txtDulieu , txtKetQua txtGiaiMa (Đ ể test đủ cịn tơi tất nhiên phải “Màu mè” rồi) Đoạn mã : Public Function Encode(Data As String, Optional Depth As Integer) As String Dim TempChar As String Dim TempAsc As Integer Dim NewData As String Dim vChar As Integer For vChar = To Len(Data) TempChar = Mid$(Data T a, vChar, 1) TempAs sc = Asc(Te empChar) If Dep pth = The en Depth = 40 If Dep pth > 254 Then T Depth h = 254 TempAs sc = TempAs sc + Depth h If Tem mpAsc > 255 Then Tem mpAsc = Tem mpAsc - 25 55 TempCh har = Chr(T TempAsc) NewDat ta = NewDat ta & TempC Char Next vChar Encod de = NewDa ata End Function F Publi ic Functio on Decode(D Data As St tring, Opti ional Dept th As Integ ger) As Strin ng Dim TempChar T As A String Dim TempAsc T As s Integer Dim NewData N As s String Dim vChar v As Integer I For v vChar = To Len(Dat ta) T TempChar = Mid$(Data a, vChar, 1) TempAs sc = Asc(Te empChar) If Dep pth = The en Depth = 40 If Dep pth > 254 Then T Depth h = 254 T TempAsc = TempAsc - Depth If Tem mpAsc < Then T TempA Asc = TempA Asc + 255 TempCh har = Chr(T TempAsc) NewDat ta = NewDat ta & TempC Char Next vChar Decod de = NewDa ata End Function F Priva ate Sub Cm mdEncode_Cl lick() TxtKe etqua.Text t = Encode( (txtDulieu u.Text, 9) End Sub S Priva ate Sub cm mdDecode_Cl lick() txtGi iaiMa.Text t = Decode( (TxtKetqua a.Text, 9) End Sub S ‘ Chú ú ý : Ở ch hỗ số chí ính số ta cần để lựa chọn kiểu Mã ho oá hay Giải mã Lời kết k : Chao ôii mệt qua a buổi lối ng gày 10 tháng 11 ngày 11 thán ng 11 hồn n thàn nh 14 Chiêu thức, t chậm t phải bạn, b phải “Lục “ tung” hếtt máy lên tìm t thấy nhữn ng chiêu “Tâm m đắt” để viếtt sách, chiêu Mã ho oá liệu dạng text làm m buổi tối tìm m ra, kiểu nàyy phải nhờ bạn u có Chiêu thứ ức hay th hì gửi Email cho m để tổng hợp nâng cấp cho sách lần sa au (An tâm ghi nhận n bạn tron ng sách h từ trang bìa đến xuất xứ chiêu thứ ức đó), m làm chán n c bạn Mà hết h Chiêu thứ ức để viết tiếp Chiêu thức lập trình phiên p tớ ới hết mong bạn đóng góp p ý kiến để ph hiên sau hoàn thiện hơ ơn uyên Dũng lớp p 11C1 trường g THPT Đăk Nông ( Thị xã ã Gia Nghĩa tỉnh t Đăk Nông g) Lê Ngu Ngà ày “Xuất bản”” : 10h sáng ngày n 12 tháng g 11 năm 200 05 ... chia đó, với lời khen nhân vật khơng nhớ tên làm vui, nhận công nhận dù chút Cuốn Chiêu thức lập trình lần nâng cấp lên với nhiều chiêu thức hình vẽ minh hoạ để giúp bạn nâng cao kiến thức Lời... bản” ? ?Chiêu thức lập trình? ?? thật buồn chẳng có lấy lời động viên từ (Ở Đăk Nơng có biết mà khoe) cịn anh em việt nam nét chẳng đối hồi thật nản, để cuối sau cố nghề nghiệp phiên Chiêu thức lập trình. .. phím”” Đơc chiêu c : Đóng g ứng dụng Đơc chiêu c 10 : Tạo o phím nóng cho c chương trình t Đơc chiêu c 11 : Tha ay đổi hình nề ền cho Deskto op Đơc chiêu c 12 : Đón ng mở khay CD-ROM C Đôc chiêu c