Đang tải... (xem toàn văn)
Sau khi “Xuất bản” cuốn “Chiêu thức lập trình” mình quả thật rất buồn vì chẳng có lấy một lời động viên từ bất kỳ ai (Ở Đăk Nông này mình có biết ai mà khoe) còn anh em ở việt nam nét thì chẳng đoái hoài gì cả vì vậy mình đã thật sự nản, để cuối cùng sau một sự cố nghề nghiệp phiên bản Chiêu thức lập trình phiên bản 2 mình viết gần hoàn thành bỗng tan vào sương khói mình đã tuyệt vọng. Nhưng mới hồi sáng khi mình “Viếng” www.caulacbovb.com một diễn đàn mình tham gia từ khá lâu...
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 : “Thả câu từ cao xuống” (Có thể nói nh vậy) Đơc chiêu : Hiện câu cách chữ Đôc chiêu : Hiện trỏ động đối tượng Đơc chiêu : Form có hình dạng theo hình ảnh bất k ỳ Đơc chiêu : “Chụp ảnh hình vào Picture” Đơc chiêu : “Vơ hiệu hố button close menu form (cả Alt-F4 luôn)” Đôc chiêu : “Kéo form di chuyển từ điểm bất kỳ” Đôc chiêu : “Ghi lại tất phím gõ tên bàn phím” Đơc chiêu : Đóng ứng dụng Đơc chiêu 10 : Tạo phím nóng cho chương trình Đơc chiêu 11 : Thay đổi hình cho Desktop Đơc chiêu 12 : Đóng mở khay CD-ROM Đôc chiêu 13 : Tạo SystemTray cho ứng dụng bạn Đôc chiêu 14 : Thay đổi Font tiếng việt cho Menu Window Đôc chiêu 15 : So sánh hai ảnh Đôc chiêu 16 : Liệt kê danh sách thành phần phần cứng máy Đôc chiêu 17 : Chương trình khởi động với Windowns Đôc chiêu 18 : Play file nhạc Midi Đôc chiêu 19 : Khoá file ảnh định dạng bmp Đôc chiêu 20 : Để form bạn chế độ “Luôn nổi” Đôc chiêu 21 : TextBox “Chịu” nhận số Đôc chiêu 22 : Để form trở nên suốt Đôc chiêu 23 : Lấy tên người sử dung Windowns Đôc chiêu 24 : Chép hình làm việc vào Picture Đơc chiêu 25 : Dấu liệu dạng text vào file Đôc chiêu 26 :Mở hộp thoại Control Panel Đơc chiêu 27 : Mã hố liệu dạng text Đôc chiêu : “Thả câu từ cao xuống” (Có thể nói nh 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 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 display '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 saùch caùc Port tại" For i = To NumPorts - Me.Print Ports(i).pPortName Next End Sub '*********************************************************************'T hô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 Dim Dim Dim Dim Dim Dim Dim AddrStr As IP_ADDR_STRING FixedInfo As FIXED_INFO Buffer As IP_ADDR_STRING pAddrStr As Long pAdapt As Long Buffer2 As IP_ADAPTER_INFO FixedInfoBuffer() As Byte 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 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 sysdm.cpl @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 joy.cpl", 5) ' 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 main.cpl @1", 5) ' Hộp thoại Modem Properties Dim dblReturn As Double dblReturn = Shell("rundll32.exe shell32.dll,Control_RunDLL modem.cpl", 5) ' Hộp thoại Mouse Properties Dim dblReturn As Double 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 tơi 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, vChar, 1) TempAsc = Asc(TempChar) If Depth = Then Depth = 40 If Depth > 254 Then Depth = 254 TempAsc = TempAsc + Depth If TempAsc > 255 Then TempAsc = TempAsc - 255 TempChar = Chr(TempAsc) NewData = NewData & TempChar Next vChar Encode = NewData End Function Public Function Decode(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, vChar, 1) TempAsc = Asc(TempChar) If Depth = Then Depth = 40 If Depth > 254 Then Depth = 254 TempAsc = TempAsc - Depth If TempAsc < Then TempAsc = TempAsc + 255 TempChar = Chr(TempAsc) NewData = NewData & TempChar Next vChar Decode = NewData End Function Private Sub CmdEncode_Click() TxtKetqua.Text = Encode(txtDulieu.Text, 9) End Sub Private Sub cmdDecode_Click() txtGiaiMa.Text = Decode(TxtKetqua.Text, 9) End Sub ‘ Chú ý : Ở chỗ số số ta cần để lựa chọn kiểu Mã hoá hay Giải mã Lời kết : Chao ôi mệt qua buổi lối ngày 10 tháng 11 ngày 11 tháng 11 hoàn thành 14 Chiêu thức, chậm phải bạn, phải “Lục tung” hết máy lên tìm thấy chiêu “Tâm đắt” để viết sách, chiêu Mã hoá liệu dạng text làm buổi tối tìm ra, kiểu phải nhờ bạn có Chiêu thức hay gửi Email cho để tổng hợp nâng cấp cho sách lần sau (An tâm ghi nhận bạn sách từ trang bìa đến xuất xứ chiêu thức đó), làm chán q bạn Mà hết Chiêu thức để viết tiếp Chiêu thức lập trình phiên tới hết mong bạn đóng góp ý kiến để phiên sau hoàn thiện Lê Nguyên Dũng lớp 11C1 trường THPT Đăk Nông ( Thị xã Gia Nghĩa tỉnh Đăk Nông) Ngày “Xuất bản” : 10h sáng ngày 12 tháng 11 năm 2005 ... 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 toàn... 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) 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. .. lần sau (An tâm ghi nhận bạn sách từ trang bìa đến xuất xứ chiêu thức đó), làm chán q bạn Mà hết Chiêu thức để viết tiếp Chiêu thức lập trình phiên tới hết mong bạn đóng góp ý kiến để phiên sau