cgi4time.bas

加入一个用VB编写CGI的VB源程序。（你需要在Win98上首先安装20Personal WebServer

Attribute VB_Name = "cgi4Time"
Option Explicit
'-------------------------------------------------
' CGI4TIME - Display a digital clock on a web page
' Author : Kevin O'Brien [[e-mail]]
'                        [[e-mail]]
' Requires CGI4VB.BAS
'-------------------------------------------------
'
'The trick to executing a cgi script from an <img> tag,
'is that you have to return an image,
'even if its a 1x1 pixel transparent gif.
'
'-------------------------------------------------
'Instead of reading the images from a disk file,
'each of the images has been loaded into a string.
'This should speed things up by reducing disk I-O on the server,
'and it means that I don't need to supply the gif files separately.
'
'Each byte within the image is represented in the string by two hex digits.
'The string will be converted back to bytes (sImage) before it's sent.
'
'To read images directly from disk, the code is much simpler:
'
'  Open "c:\digit.gif" For Binary Access Read As #1
'  sImage = String(LOF(1), Chr$(0))
'  Get #1, , sImage
'  Close #1
'------------------------------------------------------------------
'Place the following in your HTML doc. Put all of the <img> tags
'on one line without any spaces between the tags.
'
' <img src="\cgi-bin\cgi4time.exe?p=1">
' <img src="\cgi-bin\cgi4time.exe?p=2">
' <img src="\cgi-bin\cgi4time.exe?p=3">
' <img src="\cgi-bin\cgi4time.exe?p=4">
' <img src="\cgi-bin\cgi4time.exe?p=5">
' <img src="\cgi-bin\cgi4time.exe?p=6">
'------------------------------------------------------------------
'


Sub Cgi_Main()
Dim p           As String  'input parameter to indicate which char/digit
Dim sImgHex(13) As String  'hex values of image (0-9,colon,am,pm,transparent)
Dim sIndex      As String  'char/digit to be sent
Dim iIndex      As Integer 'index for sImgHex array
Dim sImage      As String  'hex values converted to bytes
Dim sTime       As String  'formatted time
Dim x           As Long    'index of byte within sImgHex

sImgHex(0) = "47494638376110001500910000FFFFFF4A7B9452C6FF0000002C00000000100015000002409C8FA9BBE20F931802D83BE77114666D54E0068CA27292635822A9DB6E5340D79D52E7013AEBB78A8AB156146191F83A064D9F086753BC5832124F8481CD2E0A003B"
sImgHex(1) = "47494638376110001500910000FFFFFF395A6B52C6FF0000002C000000001000150000023F9C8FA9BBE10F5318300AE4681DE29EA70880678089486AD33962199B66D5D429F3EBAA60FDE107EA5A21803DE1AF550C214B931927A6B3486E3E86F58A2800003B"
sImgHex(2) = "47494638376110001500910000FFFFFF315A6B52C6FF0000002C00000000100015000002469C8FA9BBE20F531802D82B280A133A9A1DDC9454A1312AE6C6A9C039A4E5CB82D1375F166C7C5ED63AAC24C11E8D4832F26245CA919504D91E4C44A6A2A345A73F86F7CB2800003B"
sImgHex(3) = "47494638376110001500910000FFFFFF315A6B52C6FF0000002C00000000100015000002449C8FA9BBE20F531802D82B280A133A9A1DDC9454A1312AE6C6A9C039A4E5CB82D1375F168C761EC8222156A2D60C261BD28AC203B1677B004514DD4E33F44418DCEEA200003B"
sImgHex(4) = "47494638376110001500910000FFFFFF315A6B52C6FF0000002C00000000100015000002409C8FA9BBE10F931830CE23660D2323015C5F388A18799A0668B28A8B4DD92CAB1D80E7B6D3D135F278A10C41C990C2339A8A252067D30322A1AA4D8481CD2E0A003B"
sImgHex(5) = "47494638376110001500910000FFFFFF315A6B52C6FF0000002C00000000100015000002449C8FA9BBE20F931802D83B037214667D545312941B3022256888CA7AA6071C4EDEA75497251BE6DD51992428212B549C0D63C65CD2A7017266941D8F22B93D18DC2EA300003B"
sImgHex(6) = "47494638376110001500910000FFFFFF315A6B52C6FF0000002C00000000100015000002429C8FA9BBE20F931802D83B037214667D545312941B3022256888CA7AA6071C4EDEA7549725B7B6D789E550420931742CB6924819E7160C51763C8AE4F66068B78C02003B"
sImgHex(7) = "47494638376110001500910000FFFFFF315A6B52C6FF0000002C00000000100015000002429C8FA9BBE20F531802D82B280A133A9A1DDC9454A1312AE6C6A9C039A4E5CBC663FB49B75CEF1DCC3BAC44AD19B08818A290421AD176036DA03B0DCBC76468B78802003B"
sImgHex(8) = "47494638376110001500910000FFFFFF52C6FF0000000000002C000000001000150000023D948FA9BBE10F531001D83BE77114666D54E0068CA27292635822A9DB6E5FC4491786CE4F07AF54CCF2BD7E42201165E4783EAEDFADB55A4618D4EAA200003B"
sImgHex(9) = "47494638376110001500910000FFFFFF315A6B52C6FF0000002C00000000100015000002409C8FA9BBE20F931802D83BE77114666D54E0068CA27292635822A9DB6E5FC44917A60441478FFA6EF3E95031C38F2804C284BC4707B1ABDC5A2B8F8781CD320A003B"
sImgHex(10) = "47494638376109001500910000FFFFFF52C6FF0000000000002C0000000009001500000215948FA9CB8DB1028049D2EAB236F74D6545DB482E05003B"
sImgHex(11) = "47494638376110001500910000FFFFFF315A6B52C6FF0000002C00000000100015000002339C8FA9CBED0FA37C20D59AC4D0467B840DD82522027072DC061EA33BC5494007886DDF478E0FB951FBF57E3E855037DBC96405003B"
sImgHex(12) = "47494638376110001500910000FFFFFF315A6B52C6FF0000002C00000000100015000002349C8FA9CBED0FA37C21D56A07D67C73835D1F1894E1E16D2738B50920C00830D08870D8F83EC7B8410BDE14BF41B1A6B0215DAD02003B"
sImgHex(13) = "47494638396101000100800000000000FFFFFF21F90401000000002C000000000100010000020144003B"
   
p = GetCgiValue("p")

' validity check - p can be 1 thru 6
If (p < "1") Or (p > "6") Then
   iIndex = 13 ' return transparent gif to satisfy <img> tag
   GoTo SendImage
End If

sTime = Format(Time, "hh\:mmampm") 'example 10:30pm

'get the correct image for the input parameter (p) that was specified
'example:  p      sIndex   iIndex
'         ---     ------   ------
'          1         1       1
'          2         0       0
'          3         :      10
'          4         3       3
'          5         0       0
'          6         P      12

sIndex = UCase$(Mid$(sTime, Val(p), 1))
Select Case sIndex
   Case "0" To "9"
      iIndex = Val(sIndex)
   Case ":"
      iIndex = 10
   Case "A"
      iIndex = 11
   Case "P"
      iIndex = 12
   Case Else
      iIndex = 13
End Select

SendImage:

   'convert the hex values of the hex-coded image to bytes.
   'remove this if you're reading your own image from disk.
   
   sImage = ""
   For x = 1 To Len(sImgHex(iIndex)) Step 2
      sImage = sImage & Chr$("&H" & Mid$(sImgHex(iIndex), x, 2))
   Next x
   
   'Use SendB() to send the image, instead of Send().
   'Make sure content-type agrees with what you're sending.
   'Use image/jpeg for jpg files.
   
   Send "Status: 200 OK"
   Send "Content-type: image/gif" & vbCrLf
   SendB sImage
End Sub