如何编程实现对.pif文件的访问控制.txt

VB技巧问答10000例 VB技巧问答10000例

微 软 没 有 公 开 发 表 .PIF文 件 的 格 式 ， 下 面 的 这 个 VB的 例 子 程 序 表 明 了 .PIF文 件 的 基 本 格 式 ， 供 你 参 考 。 其 中 sPIF表 示 .PIF文 件 的 文 件 名 。 
    Sub GetPIFInformation (sPIF As String) 
    Dim l0190 As Integer 
    Dim l0192 As Variant 
    Dim sInfo As String 
    Dim l0198 As String 
    Dim l019A As String 
    Dim l019E As Long 
    Dim l01A0 As Long 
    Dim l01A2 As Long 
    Dim l01A4 As Integer 
    Dim l01A6 As Long 
    Dim l01AE As Long 
    Dim l01B8 As Integer 
    Dim l01BA As Integer 
    Dim l01BC As Integer 
    Dim l01BE As Integer 
    Dim l01C0 As Long 
    Static m01C4 As Integer 
     l0192 = sPIF 
     List1.AddItem l0192 
     l01AE = 370 
     Open sPIF For Binary Access Read As #1 
     l0198 = String$(64, " ") 
     Get #1, l01AE, l0198 
     Close #1 
     l019E = Val("&H" + Hex(Asc(Mid$(l0198, 18, 1)))) * 256 
     l019E = l019E + Val("&H" + Hex(Asc(Mid$(l0198, 17, 1)))) 
     l01A0 = Val("&H" + Hex(Asc(Mid$(l0198, 22, 1)))) * 256 
     l01A0 = l01A0 + Val("&H" + Hex(Asc(Mid$(l0198, 21, 1)))) 
     l01A2 = Val("&H" + Hex(Asc(Mid$(l0198, 40, 1)))) * 256 
     l01A2 = l01A2 + Val("&H" + Hex(Asc(Mid$(l0198, 39, 1)))) 
     Open sPIF For Binary Access Read As #1 
     l0198 = String$(16, " ") 
     Get #1, l019E + 1, l0198 
     Close #1 
     If Mid$(l0198, 9, 3) = "286" Then 
     List1.AddItem " ( 2 8 6 F O R M A T )" 
     l01A4 = 1 
     Else 
     If Mid$(l0198, 9, 3) = "386" Then 
     List1.AddItem " ( 3 8 6 F O R M A T )" 
     l01A4 = 0 
     Else 
     List1.AddItem " ( ? ? ? F O R M A T )" 
     l01A4 = 9 
     End If 
     End If 
     l01AE = 37 
     Open sPIF For Binary Access Read As #1 
     l0198 = String$(64, " ") 
     Get #1, l01AE, l0198 
     Close #1 
     l0190 = 64 
     Call CStrToBStr(l0198, l019A, l0190) 
     List1.AddItem "Program Filename=<<" + l019A + ">>" 
     l01AE = 3 
     Open sPIF For Binary Access Read As #1 
     l0198 = String$(48, " ") 
     Get #1, l01AE, l0198 
     Close #1 
     l0190 = 30 
     Call CStrToBStr(l0198, l019A, l0190) 
     List1.AddItem "Window Title=<<" + l019A + ">>" 
     If l01A4 = 0 Then 
     l01AE = 454 
     End If 
     If l01A4 = 1 Then 
     l01AE = 482 
     End If 
     Open sPIF For Binary Access Read As #1 
     l0198 = String$(64, " ") 
     Get #1, l01AE, l0198 
     Close #1 
     l0190 = 64 
     Call CStrToBStr(l0198, l019A, l0190) 
     List1.AddItem "Optional Parameters=<<" + l019A + ">>" 
     l01AE = 102 
     Open sPIF For Binary Access Read As #1 
     l0198 = String$(64, " ") 
     Get #1, l01AE, l0198 
     Close #1 
     l0190 = 64 
     Call CStrToBStr(l0198, l019A, l0190) 
     List1.AddItem "Start-up Directory=<<" + l019A + ">>" 
     If l01B8 < TextWidth(l019A) + 23 Then l01B8 = TextWidth(l019A) + 23 
     If l01A4 = 0 Then 
     l01AE = 410 
     End If 
     If l01A4 = 1 Then 
     l01AE = 438 
     End If 
     Open sPIF For Binary Access Read As #1 
     l0198 = String$(64, " ") 
     Get #1, l01AE, l0198 
     Close #1 
     sInfo = "Video Memory:" 
     If (Asc(Mid$(l0198, 25, 1)) And &H40) > 0 Then 
     sInfo = sInfo & " High Graphics" 
     End If 
     If (Asc(Mid$(l0198, 25, 1)) And &H20) > 0 Then 
     sInfo = sInfo & " Low Graphics" 
     End If 
     If (Asc(Mid$(l0198, 25, 1)) And &H10) > 0 Then 
     sInfo = sInfo & " Text" 
     End If 
     List1.AddItem sInfo 
     l01A6 = Val("&H" + Hex(Asc(Mid$(l0198, 8, 1)))) * 256 
     l01A6 = l01A6 + Val("&H" + Hex(Asc(Mid$(l0198, 7, 1)))) 
     sInfo = "Memory Req: KB Required" & Str$(l01A6) 
     sInfo = sInfo & Space$(6 - Len(Str$(l01A6))) 
     l01A6 = Val("&H" + Hex(Asc(Mid$(l0198, 6, 1)))) * 256 
     l01A6 = l01A6 + Val("&H" + Hex(Asc(Mid$(l0198, 5, 1)))) 
     sInfo = sInfo & " KB Desired " & Str$(l01A6) 
     List1.AddItem sInfo 
     l01A6 = Val("&H" + Hex(Asc(Mid$(l0198, 16, 1)))) * 256 
     l01A6 = l01A6 + Val("&H" + Hex(Asc(Mid$(l0198, 15, 1)))) 
     sInfo = "EMS Memory: KB Required" & Str$(l01A6) 
     sInfo = sInfo & Space$(6 - Len(Str$(l01A6))) 
     l01A6 = Val("&H" + Hex(Asc(Mid$(l0198, 14, 1)))) * 256 
     l01A6 = l01A6 + Val("&H" + Hex(Asc(Mid$(l0198, 13, 1)))) 
     sInfo = sInfo & " KB Limit " & Str$(l01A6) 
     List1.AddItem sInfo 
     l01A6 = Val("&H" + Hex(Asc(Mid$(l0198, 20, 1)))) * 256 
     l01A6 = l01A6 + Val("&H" + Hex(Asc(Mid$(l0198, 19, 1)))) 
     sInfo = "XMS Memory: KB Required" & Str$(l01A6) 
     sInfo = sInfo & Space$(6 - Len(Str$(l01A6))) 
     l01A6 = Val("&H" + Hex(Asc(Mid$(l0198, 18, 1)))) * 256 
     l01A6 = l01A6 + Val("&H" + Hex(Asc(Mid$(l0198, 17, 1)))) 
     sInfo = sInfo & " KB Limit " & Str$(l01A6) 
     List1.AddItem sInfo 
     sInfo = "Display Usage: " 
     If (Asc(Mid$(l0198, 21, 1)) And &H8) > 0 Then 
     sInfo = sInfo & "Full Screen" 
     Else 
     sInfo = sInfo & "Windowed " 
     End If 
     sInfo = sInfo & " Execution: " 
     If (Asc(Mid$(l0198, 21, 1)) And &H2) > 0 Then 
     sInfo = sInfo & "Background" 
     Else 
     sInfo = sInfo & "Foreground" 
     End If 
     List1.AddItem sInfo 
     sInfo = " " 
     If (Asc(Mid$(l0198, 21, 1)) And &H1) > 0 Then 
     sInfo = sInfo & "Close Window on Exit OFF" 
     Else 
     sInfo = sInfo & "Close Window on Exit ON" 
     End If 
     sInfo = sInfo & " " 
     If (Asc(Mid$(l0198, 21, 1)) And &H4) > 0 Then 
     sInfo = sInfo & "Exclusive" 
     Else 
     sInfo = sInfo & "Shared " 
     End If 
     List1.AddItem sInfo 
     sInfo = "- - - - - - - - - - - - - - - - - - - - - - - - - - - -" 
     List1.AddItem sInfo 
     If l01B8 < TextWidth(sInfo) Then l01B8 = TextWidth(sInfo) 
     l01A0 = Val("&H" + Hex(Asc(Mid$(l0198, 12, 1)))) * 256 
     l01A0 = l01A0 + Val("&H" + Hex(Asc(Mid$(l0198, 11, 1)))) 
     l01A2 = Val("&H" + Hex(Asc(Mid$(l0198, 10, 1)))) * 256 
     l01A2 = l01A2 + Val("&H" + Hex(Asc(Mid$(l0198, 9, 1)))) 
     sInfo = "Background Priority:" & Str$(l01A0) 
     sInfo = sInfo & " Foreground Priority:" & Str$(l01A2) 
     List1.AddItem sInfo 
     sInfo = " " 
     If (Asc(Mid$(l0198, 22, 1)) And &H10) > 0 Then 
     sInfo = sInfo & "Detect Idle Time ON" 
     Else 
     sInfo = sInfo & "Detect Idle Time OFF" 
     End If 
     List1.AddItem sInfo 
     If (Asc(Mid$(l0198, 22, 1)) And &H80) > 0 Then 
     sInfo = "EMS Memory Locked ON " 
     Else 
     sInfo = "EMS Memory Locked OFF" 
     End If 
     sInfo = sInfo & " " 
     If (Asc(Mid$(l0198, 23, 1)) And &H1) > 0 Then 
     sInfo = sInfo & "XMS Memory Locked ON" 
     Else 
     sInfo = sInfo & "XMS Memory Locked OFF" 
     End If 
     List1.AddItem sInfo 
     If (Asc(Mid$(l0198, 22, 1)) And &H20) > 0 Then 
     sInfo = "Uses High Memory OFF" 
     Else 
     sInfo = "Uses High Memory ON " 
     End If 
     sInfo = sInfo & " " 
     If (Asc(Mid$(l0198, 23, 1)) And &H4) > 0 Then 
     sInfo = sInfo & "Lock Application Memory ON" 
     Else 
     sInfo = sInfo & "Lock Application Memory OFF" 
     End If 
     List1.AddItem sInfo 
     sInfo = "Monitor: " 
     If (Asc(Mid$(l0198, 25, 1)) And &H2) > 0 Then 
     sInfo = sInfo & "Text OFF" 
     Else 
     sInfo = sInfo & "Text ON " 
     End If 
     sInfo = sInfo & " " 
     If (Asc(Mid$(l0198, 25, 1)) And &H4) > 0 Then 
     sInfo = sInfo & "Low Graphics OFF" 
     Else 
     sInfo = sInfo & "Low Graphics ON " 
     End If 
     sInfo = sInfo & " " 
     If (Asc(Mid$(l0198, 25, 1)) And &H8) > 0 Then 
     sInfo = sInfo & "High Graphics OFF" 
     Else 
     sInfo = sInfo & "High Graphics ON" 
     End If 
     List1.AddItem sInfo 
     sInfo = " " 
     If (Asc(Mid$(l0198, 25, 1)) And &H1) > 0 Then 
     sInfo = sInfo & "Emulate Text Mode ON " 
     Else 
     sInfo = sInfo & "Emulate Text Mode OFF" 
     End If 
     sInfo = sInfo & " " 
     If (Asc(Mid$(l0198, 25, 1)) And &H80) > 0 Then 
     sInfo = sInfo & "Retain Video Memory ON" 
     Else 
     sInfo = sInfo & "Retain Video Memory OFF" 
     End If 
     List1.AddItem sInfo 
     sInfo = " " 
     If (Asc(Mid$(l0198, 23, 1)) And &H2) > 0 Then 
     sInfo = sInfo & "Allow Fast Paste ON " 
     Else 
     sInfo = sInfo & "Allow Fast Paste OFF" 
     End If 
     sInfo = sInfo & " " 
     If (Asc(Mid$(l0198, 21, 1)) And &H1) > 0 Then 
     sInfo = sInfo & "Allow Close When Active ON" 
     Else 
     sInfo = sInfo & "Allow Close When Active OFF" 
     End If 
     List1.AddItem sInfo 
     sInfo = "Keys: " 
     If (Asc(Mid$(l0198, 21, 1)) And &H20) > 0 Then 
     sInfo = sInfo & "Alt+Tab ON " 
     Else 
     sInfo = sInfo & "Alt+Tab OFF" 
     End If 
     sInfo = sInfo & " " 
     If (Asc(Mid$(l0198, 21, 1)) And &H40) > 0 Then 
     sInfo = sInfo & "Alt+Esc ON " 
     Else 
     sInfo = sInfo & "Alt+Esc OFF" 
     End If 
     sInfo = sInfo & " " 
     If (Asc(Mid$(l0198, 22, 1)) And &H8) > 0 Then 
     sInfo = sInfo & "Ctrl+Esc ON" 
     Else 
     sInfo = sInfo & "Ctrl+Esc OFF" 
     End If 
     List1.AddItem sInfo 
     sInfo = " " 
     If (Asc(Mid$(l0198, 22, 1)) And &H4) > 0 Then 
     sInfo = sInfo & "PrtSc ON " 
     Else 
     sInfo = sInfo & "PrtSc OFF" 
     End If 
     sInfo = sInfo & " " 
     If (Asc(Mid$(l0198, 22, 1)) And &H2) > 0 Then 
     sInfo = sInfo & "Alt+PrtSc ON " 
     Else 
     sInfo = sInfo & "Alt+PrtSc OFF" 
     End If 
     sInfo = sInfo & " " 
     If (Asc(Mid$(l0198, 21, 1)) And &H80) > 0 Then 
     sInfo = sInfo & "Alt+Space ON" 
     Else 
     sInfo = sInfo & "Alt+Space OFF" 
     End If 
     List1.AddItem sInfo 
     sInfo = " " 
     If (Asc(Mid$(l0198, 22, 1)) And &H1) > 0 Then 
     sInfo = sInfo & "Alt+Enter ON " 
     Else 
     sInfo = sInfo & "Alt+Enter OFF" 
     End If 
     List1.AddItem sInfo 
     l01A0 = Val("&H" + Hex(Asc(Mid$(l0198, 30, 1)))) * 256 
     l01A0 = l01A0 + Val("&H" + Hex(Asc(Mid$(l0198, 31, 1)))) 
     l01A2 = Val("&H" + Hex(Asc(Mid$(l0198, 28, 1)))) * 256 
     l01A2 = l01A2 + Val("&H" + Hex(Asc(Mid$(l0198, 29, 1)))) 
     ' Application Shortcut Key: 
     sInfo = " Application Shortcut Key: " 
     Select Case l01A0 
     Case 0: sInfo = sInfo & " " 
     Case 4: sInfo = sInfo & "Ctrl+" 
     Case 8: sInfo = sInfo & "Alt+" 
     Case 11: sInfo = sInfo & "Alt+Shift+" 
     Case 12: sInfo = sInfo & "Alt+Ctrl+" 
     Case 15: sInfo = sInfo & "Alt+Ctrl+Shift+" 
     Case Else: sInfo = sInfo & "??+" 
     End Select 
     Select Case l01A2 
     Case 0: sInfo = sInfo & "none" 
     Case 1: sInfo = sInfo & "01?" 
     Case 2: sInfo = sInfo & "1" 
     Case 3: sInfo = sInfo & "2" 
     Case 4: sInfo = sInfo & "3" 
     Case 5: sInfo = sInfo & "4" 
     Case 6: sInfo = sInfo & "5" 
     Case 7: sInfo = sInfo & "6" 
     Case 8: sInfo = sInfo & "7" 
     Case 9: sInfo = sInfo & "8" 
     Case 10: sInfo = sInfo & "9" 
     Case 11: sInfo = sInfo & "0" 
     Case 12: sInfo = sInfo & "-" 
     Case 13: sInfo = sInfo & "=" 
     Case 14: sInfo = sInfo & "14?" 
     Case 15: sInfo = sInfo & "15?" 
     Case 16: sInfo = sInfo & "Q" 
     Case 17: sInfo = sInfo & "W" 
     Case 18: sInfo = sInfo & "E" 
     Case 19: sInfo = sInfo & "R" 
     Case 20: sInfo = sInfo & "T" 
     Case 21: sInfo = sInfo & "Y" 
     Case 22: sInfo = sInfo & "U" 
     Case 23: sInfo = sInfo & "I" 
     Case 24: sInfo = sInfo & "O" 
     Case 25: sInfo = sInfo & "P" 
     Case 26: sInfo = sInfo & "[" 
     Case 27: sInfo = sInfo & "]" 
     Case 28: sInfo = sInfo & "28?" 
     Case 29: sInfo = sInfo & "29?" 
     Case 30: sInfo = sInfo & "A" 
     Case 31: sInfo = sInfo & "S" 
     Case 32: sInfo = sInfo & "D" 
     Case 33: sInfo = sInfo & "F" 
     Case 34: sInfo = sInfo & "G" 
     Case 35: sInfo = sInfo & "H" 
     Case 36: sInfo = sInfo & "J" 
     Case 37: sInfo = sInfo & "K" 
     Case 38: sInfo = sInfo & "L" 
     Case 39: sInfo = sInfo & ";" 
     Case 40: sInfo = sInfo & "'" 
     Case 41: sInfo = sInfo & "`" 
     Case 42: sInfo = sInfo & "42?" 
     Case 43: sInfo = sInfo & "\" 
     Case 44: sInfo = sInfo & "Z" 
     Case 45: sInfo = sInfo & "X" 
     Case 46: sInfo = sInfo & "C" 
     Case 47: sInfo = sInfo & "V" 
     Case 48: sInfo = sInfo & "B" 
     Case 49: sInfo = sInfo & "N" 
     Case 50: sInfo = sInfo & "M" 
     Case 51: sInfo = sInfo & "," 
     Case 52: sInfo = sInfo & "." 
     Case 53: sInfo = sInfo & "/" 
     Case 54: sInfo = sInfo & "54?" 
     Case 55: sInfo = sInfo & "55?" 
     Case 56: sInfo = sInfo & "56?" 
     Case 57: sInfo = sInfo & "57?" 
     Case 58: sInfo = sInfo & "58?" 
     Case 59: sInfo = sInfo & "F1" 
     Case 60: sInfo = sInfo & "F2" 
     Case 61: sInfo = sInfo & "F3" 
     Case 62: sInfo = sInfo & "F4" 
     Case 63: sInfo = sInfo & "F5" 
     Case 64: sInfo = sInfo & "F6" 
     Case 65: sInfo = sInfo & "F7" 
     Case 66: sInfo = sInfo & "F8" 
     Case 67: sInfo = sInfo & "F9" 
     Case 68: sInfo = sInfo & "F10" 
     Case 69: sInfo = sInfo & "NumLock" 
     Case 70: sInfo = sInfo & "70?" 
     Case 71: sInfo = sInfo & "Home" 
     Case 72: sInfo = sInfo & "Up" 
     Case 73: sInfo = sInfo & "PgUp" 
     Case 74: sInfo = sInfo & "NumMinus" 
     Case 75: sInfo = sInfo & "Left" 
     Case 76: sInfo = sInfo & "76?" 
     Case 77: sInfo = sInfo & "Right" 
     Case 78: sInfo = sInfo & "NumPlus" 
     Case 79: sInfo = sInfo & "End" 
     Case 80: sInfo = sInfo & "Down" 
     Case 81: sInfo = sInfo & "PgDn" 
     Case 82: sInfo = sInfo & "Ins" 
     Case 83: sInfo = sInfo & "Del" 
     Case 84: sInfo = sInfo & "F11" 
     Case 85: sInfo = sInfo & "F12" 
     Case Else: sInfo = sInfo & "???": Call sub538(Mid$(l0198, 28, 2)) 
     End Select 
     List1.AddItem sInfo 
    End Sub 
     
    Sub CStrToBStr (p0066 As String, p0068 As String, p006A As Integer) 
    Dim l006C As String 
    Dim l006E As Integer 
     l006C = Mid$(p0066, 1, 1) 
     l006E = 1 
     p0068 = "" 
     Do Until Asc(l006C) = 0 
     If l006E > p006A Then Exit Do 
     p0068 = p0068 + l006C 
     l006E = l006E + 1 
     l006C = Mid$(p0066, l006E, 1) 
     Loop 
    End Sub 
     
    Sub sub538 (ByVal p021C As String) 
    Dim l021E As String 
    Dim l0220 As String 
    Dim l0222 As Integer 
     l0222 = 1 
     l021E = " 01: " 
     While l0222 <= Len(p021C$) 
     l0220 = Hex(Asc(Mid$(p021C$, l0222, 1))) 
     If Len(l0220) < 2 Then l0220 = "0" + l0220 
     l021E = l021E + l0220 + " " 
     l0222 = l0222 + 1 
     If (l0222 - 1) Mod 16 = 0 Then 
     List1.AddItem l021E 
     l021E = Str$(l0222) + ": " 
     Else If (l0222 - 1) Mod 8 = 0 Then l021E = l021E + "- " 
     End If 
     Wend 
     List1.AddItem l021E 
    End Sub 
<END>