home *** CD-ROM | disk | FTP | other *** search
/ .net 1999 December / netCD65.iso / pc / Software / VirtualA / 16bit / vaper16.exe / %MYDIR% / EXEC.EBS < prev    next >
Encoding:
Text File  |  1999-10-06  |  8.8 KB  |  342 lines
  1. 'T:EXEC.EBS for CompuServe
  2. ' VA 4.01 release
  3.  
  4. Global Const IM_DELETE    = 2048
  5.  
  6. Declare Function UniqueFileName$
  7. Declare Function QueueFile(service As String, sfilename As String, queueflags As Long) As Boolean
  8. Declare Sub ReportSuccess(id As String)
  9. Declare Function StartCapture(pseudo As String)
  10. Declare Function WaitForEitherTimed(s1 As String, s2 As String, timeout As Integer) As String
  11. Declare Function GoForum(ByVal forum As String) As Boolean
  12. Declare Sub ResetForum
  13.  
  14. Dim CisError As Boolean
  15.  
  16. 'T:CreateExecTrackers (subroutine) (CompuServe)
  17. Sub CreateExecTrackers
  18.     Dim t As Tracker
  19.  
  20.     ' Special for Financial & Exec stuff
  21.     Set t = CreateTracker("PromptIssue1", "\n\rIssue:")
  22.     Set t = CreateTracker("PromptIssue2", "\nIssue:")
  23.     Set t = CreateTracker("PromptIssueError", "\nPress <CR> to continue !")
  24.     Set t = CreateTracker("PromptCommodity1", "\n\rCommodity:")
  25.     Set t = CreateTracker("PromptCommodity2", "\nCommodity:")
  26.     Set t = CreateTracker("PromptCompany1", "\n\rCompany:")
  27.     Set t = CreateTracker("PromptCompany2", "\nCompany:")
  28. End Sub
  29.  
  30. 'T:DestroyExecTrackers (subroutine) (CompuServe)
  31. Sub DestroyExecTrackers
  32.     Dim t As Tracker
  33.  
  34.     ' Special for Financial & Exec stuff
  35.     Trackers("PromptIssue1").delete
  36.     Trackers("PromptIssue2").delete
  37.     Trackers("PromptIssueError").delete
  38.     Trackers("PromptCommodity1").delete
  39.     Trackers("PromptCommodity2").delete
  40.     Trackers("PromptCompany1").delete
  41.     Trackers("PromptCompany2").delete
  42. End Sub
  43.  
  44. 'T:CisErrorProc (subroutine) (CompuServe)
  45. ' Called when CIS puts up a \n% error
  46. Sub CisErrorProc(t As Tracker)
  47.     CisError = True
  48.     t.reset
  49. End Sub
  50.  
  51. 'T:GeneralIssue (subroutine) (CompuServe)
  52. Sub GeneralIssue(id As String, forum As String, pseudo As String, ticker As String)
  53.     Dim filename As String
  54.  
  55.     ' Go to main page
  56.     If Not GoForum(forum) Then
  57.         LogResult "Failed trying to GO "+forum
  58.         Exit Sub
  59.     End If
  60.     ResetForum
  61.     CreateExecTrackers
  62.  
  63.     ' Start capturing
  64.     filename = StartCapture("Stocks/"+pseudo)
  65.     CaptureText "Ticker:"
  66.  
  67.     ' Send the command
  68.     Terminal.Status "Collecting Information ... Please Wait"
  69.     Terminal.Enabled=False
  70.     Comms.Send ticker+"\r"
  71.  
  72.     ' Get all messages
  73.     WaitForPrompt "PromptIssue"
  74.     CaptureRewind 7
  75.     CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
  76.     
  77.     ' Clean up
  78.     Capture CAPTURE_OFF
  79.     Comms.Send "\r"
  80.     WaitForPrompt "Prompt"
  81.     Terminal.Enabled=True
  82.  
  83.     ' Add to import queue
  84.     If QueueFile(Session.Service, filename, IM_DELETE) Then
  85.         ReportSuccess id & " : Collect stock information about " & ticker & " "
  86.     End If
  87.     DestroyExecTrackers
  88. End Sub
  89.  
  90. 'T:SingleStock (subroutine) (CompuServe)
  91. Sub SingleStock(id As String, ticker As String)
  92.     GeneralIssue id, "cis:basicquotes", "Quotes CompuServe", ticker
  93. End Sub
  94.  
  95. 'T:GlobalStock (subroutine) (CompuServe)
  96. Sub GlobalStock(id As String, ticker As String)
  97.     GeneralIssue id, "cis:rcq-5", "Quotes CompuServe", ticker
  98. End Sub 
  99.  
  100. 'T:ExchangeRates (subroutine) (CompuServe)
  101. Sub ExchangeRates(id As String)
  102.     GeneralIssue id, "cis:basicquotes", "Exchange_Rates CompuServe", _
  103.         "XRAD,XRBP,XRCD,XRFF,XRGM,XRJY,XRSF"
  104. End Sub
  105.  
  106. 'T:SendSedol (subroutine) (CompuServe)
  107. ' Sends a sedol symbol to CIS
  108. Sub SendSedol(sedol As String)
  109.     ' Supports the following formats:
  110.     ' "S:<sedol>", "*<company>" or "<sedol>"
  111.     If Mid(sedol, 1, 1)="*" Or UCase(Mid(Sedol, 1, 1))="S" Then
  112.         Comms.Send sedol+"\r"           ' Allow searching of SEDOLs
  113.     Else
  114.         Comms.Send "S:"+sedol+"\r"
  115.     End If
  116. End Sub
  117.  
  118. 'T:UKPrice (subroutine) (CompuServe)
  119. Sub UKPrice(id As String, sedol As String, period As String, start As String, enddate As String)
  120.     Dim filename As String
  121.     Dim failed As Boolean
  122.     Dim t As Tracker
  123.  
  124.     ' Validate parameters
  125.     period = UCase(Mid(period, 1, 1))
  126.     If Not InStr("DWM", period) Then period = "D"
  127.  
  128.     ' Go to main page
  129.     If Not GoForum("cis:efs-13") Then
  130.         LogResult "Failed trying to GO EFS-13"
  131.         Exit Sub
  132.     End If
  133.     ResetForum
  134.     CreateExecTrackers
  135.  
  136.     CisError = False
  137.     Set t = CreateTracker("CisError", "\n%*\r", "CisErrorProc", False, True)
  138.  
  139.     ' Send the command
  140.     SendSedol sedol
  141.     WaitFor sedol+"\r"
  142.  
  143.     ' Start capturing
  144.     failed = False
  145.     filename = StartCapture("Stocks/UK_Price CompuServe")
  146.     CaptureText "Sedol:"+sedol+" Start:"+start+" End:"+enddate+Basic.Eoln$
  147.     If WaitForEitherTimed("onthly? :", "\n!", 100)="\n!" Then
  148.         CaptureRewind 1
  149.     Else
  150.         Comms.Send period+"\r"
  151.         WaitFor "date?"
  152.         Comms.Send start+"\r"
  153.         If WaitForEitherTimed("\?", "\n!", 100)="\n!" Then
  154.             failed = True
  155.             CaptureRewind 1
  156.         Else
  157.             If CisError Then
  158.                 CaptureRewind 7
  159.             Else
  160.                 Comms.Send enddate+"\r"
  161.                 ' Wait for results
  162.                 CaptureRewind Len(WaitForEitherTimed("\n!", "Name:", 100))
  163.             End If
  164.         End If
  165.     End If
  166.     CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
  167.     
  168.     ' Clean up
  169.     t.delete
  170.     Capture CAPTURE_OFF
  171.     If failed Then
  172.         GoTop
  173.     Else
  174.         Comms.Send "\r"
  175.         WaitForPrompt "Prompt"
  176.         Comms.Send "\r"
  177.         WaitForPrompt "Prompt"
  178.     End If
  179.  
  180.     ' Add to import queue
  181.     If QueueFile(Session.Service, filename, IM_DELETE) Then
  182.         ReportSuccess id & " : Collect stock information about " & sedol & " "
  183.     End If
  184.     DestroyExecTrackers
  185. End Sub
  186.  
  187. 'T:SedolCompanyTicker (subroutine) (CompuServe)
  188. Sub SedolCompanyTicker(id As String, mnu As String, cname As String)
  189.     Dim filename As String
  190.  
  191.     ' Go to main page
  192.     If Not GoForum("cis:efs-14") Then
  193.         LogResult "Failed trying to GO EFS-14"
  194.         Exit Sub
  195.     End If
  196.     ResetForum
  197.     CreateExecTrackers
  198.  
  199.     ' Send the command
  200.     If mnu="2" Then
  201.         Comms.Send "2\r"                 'Ticker
  202.         WaitFor "Symbol:"
  203.     Else
  204.         Comms.Send "1\r"    'Company
  205.         WaitFor "Name:"
  206.     End If
  207.     Comms.Send cname+"\r"
  208.     WaitFor cname
  209.  
  210.     ' Start capturing
  211.     filename = StartCapture("Stocks/UK_Price CompuServe")
  212.     CaptureText cname+Basic.Eoln$
  213.     If mnu="2" Then
  214.         CaptureRewind Len(WaitForEitherTimed("!", "Symbol:", 60))
  215.     Else
  216.         CaptureRewind Len(WaitForEitherTimed("!", "Name:", 60))
  217.     End If
  218.     CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
  219.     
  220.     ' Clean up
  221.     Capture CAPTURE_OFF
  222.     Comms.Send "\r"
  223.     WaitForPrompt "Prompt"
  224.     GoTop
  225.  
  226.     ' Add to import queue
  227.     If QueueFile(Session.Service, filename, IM_DELETE) Then
  228.         ReportSuccess id & " : Collect stock information about " & cname & " "
  229.     End If
  230.     DestroyExecTrackers
  231. End Sub
  232.  
  233. 'T:UKLatest (subroutine) (CompuServe)
  234. Sub UKLatest(id As String, sedol As String, period As String, num As String)
  235.     UKPrice id, sedol, period, num, ""
  236. End Sub
  237.  
  238. 'T:GeneralCommodity (subroutine) (CompuServe)
  239. Sub GeneralCommodity(id As String, start As String, enddate As String, period As String, symword As String)
  240.     Dim filename As String
  241.  
  242.     ' Make sure it's valid
  243.     period = UCase(Mid(period, 1, 1))
  244.     If Not InStr("DWM", period) Then period = "D"
  245.  
  246.     ' Go to main page
  247.     If Not GoForum("cis:cprice") Then
  248.         LogResult "Failed trying to GO CPRICE"
  249.         Exit Sub
  250.     End If
  251.     ResetForum
  252.     CreateExecTrackers
  253.  
  254.     ' Send the command
  255.     Comms.Send "/date\r"
  256.     WaitFor "\? :"
  257.     Comms.Send period+"\r"
  258.     WaitFor "\?"
  259.     Comms.Send start+"\r"
  260.     WaitFor "\?"
  261.     Comms.Send enddate+"\r"
  262.     WaitForPrompt "PromptCommodity"
  263.     Comms.Send symword+"\r"
  264.  
  265.     ' Start capturing
  266.     filename = StartCapture("Stocks/Commodities CompuServe")
  267.  
  268.     If WaitForEitherTimed("!", ":", 60)="!" Then
  269.         Comms.Send "1\r"
  270.         WaitFor "1\r"
  271.         WaitFor "!"
  272.     End If
  273.     CaptureRewind 1
  274.     CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
  275.     
  276.     ' Clean up
  277.     Capture CAPTURE_OFF
  278.     Comms.Send "\r\r"
  279.     WaitForPrompt "Prompt"
  280.     GoTop
  281.  
  282.     ' Add to import queue
  283.     If QueueFile(Session.Service, filename, IM_DELETE) Then
  284.         ReportSuccess id & " : Collect stock information about " & symword & " "
  285.     End If
  286.     DestroyExecTrackers
  287. End Sub
  288.  
  289. 'T:SingleCommodity (subroutine) (CompuServe)
  290. Sub SingleCommodity(id As String, start As String, symdate As String)
  291.     GeneralCommodity id, start, "", "d", symdate
  292. End Sub
  293.  
  294. 'T:BasicCompany (subroutine) (CompuServe)
  295. Sub BasicCompany(id As String, ticker As String)
  296.     Dim filename As String
  297.     Dim t As Tracker
  298.  
  299.     ' Go to main page
  300.     If Not GoForum("cis:bdi-1") Then
  301.         LogResult "Failed trying to GO BDI-1"
  302.         Exit Sub
  303.     End If
  304.     ResetForum
  305.     CreateExecTrackers
  306.  
  307.     ' Install handler to trap potential problem
  308.     Set t = CreateTracker("PromptExtra", "1 List companies found")
  309.  
  310.     ' Send the command
  311.     
  312.     Comms.Send ticker+"\r"
  313.  
  314.     ' Start capturing
  315.     filename = StartCapture("Stocks/Company_Info CompuServe")
  316.     CaptureText "Company:"
  317.     Terminal.Status "Collecting Information ... Please Wait"
  318.     Terminal.Enabled=False
  319.     WaitForPrompt "Prompt"
  320.     If PromptMatches("PromptExtra") Then
  321.         WaitForPrompt "PromptMain"
  322.         Comms.Send "1\r"
  323.         WaitForPrompt "PromptMain"
  324.     End If
  325.     t.delete
  326.     CaptureRewind 1
  327.     CaptureText Basic.Eoln$+"!end"+Basic.Eoln$
  328.     
  329.     ' Clean up
  330.     Capture CAPTURE_OFF
  331.     Terminal.Enabled=True
  332.  
  333.  
  334.     ' Add to import queue
  335.     If QueueFile(Session.Service, filename, IM_DELETE) Then
  336.         ReportSuccess id & " : Collect information about " & ticker & " "
  337.     End If
  338.     DestroyExecTrackers
  339. End Sub
  340.  
  341.  
  342.