Collection of Hack-Phreak Scene Programs/cleanhpvac.zip/cleanhpvac/QM95REAL.ZIP/SCRIPTS.Z/MAKEDEL3.QSC

Text File | 1995-08-24 | 11KB | 314 lines

'
' This script is used to automatically create and add new dialing directory
' entry for Delphi
'
'--------------------------------------------------------------------------=[ Constants    ]=-
const WS_BORDER        = 0x00800000
const WS_VSCROLL       = 0x00200000
const WS_TABSTOP       = 0x00010000
const LB_RESETCONTENT  = 0x0184
const LB_GETTEXT       = 0x0189
const LB_SETTABSTOPS   = 0x0192
const LBS_NOTIFY       = 0x0001
const LBS_SORT         = 0x0002
const LBS_USETABSTOPS  = 0x0080
const LBS_STANDARD     = LBS_NOTIFY+WS_BORDER+WS_VSCROLL+WS_TABSTOP
const CB_GETLBTEXT     = 0x0148
const CB_RESETCONTENT  = 0x014B
const CBS_DROPDOWNLIST = 0x0003
const CBS_SORT         = 0x0100
const CBS_STANDARD     = CBS_DROPDOWNLIST+WS_VSCROLL+WS_TABSTOP

'--------------------------------------------------------------------------=[ Dialogs      ]=---
dialog Generator 5, 10, 205, 240
  caption "Delphi Online Service"
  groupbox "User Information", -1, 10, 10, 185, 55
  rtext "Your PIN", -1, 15, 25, 50, 15
  userid as edittext 101, 70, 25, 95, 15
  rtext "Your Password", -1, 15, 45, 50, 15
  password as edittext 102, 70, 45, 95, 15

  groupbox "Connection Information",-1,10,70,185,55
  ltext "Modem",        -1, 15,85, 40, 15
  modem as combobox    106, 60,85,130, 50,
  ltext "Service",      -1, 15,105, 40, 15
  service as combobox  107, 60,105,130, 50,CBS_STANDARD

  groupbox "Phone Information",-1, 10, 135, 185,75
  pushbutton "Search Phone Database", 112, 100, 150, 90, 15
  ltext "Phone Number", -1, 15,170, 70, 15
  areacode as edittext 103,100,170, 25, 15
  number as edittext   104,130,170, 60, 15
  ltext "Country"  ,    -1, 15,190, 40, 15
  country as combobox  105, 60,190,130, 50,CBS_STANDARD+CBS_SORT

  defpushbutton "Make Script", 114, 15, 220, 50, 14
  pushbutton "Cancel", IDCANCEL, 75, 220, 50, 14
  pushbutton "About/Info", 113, 135, 220, 50, 14
end dialog

dialog phonesearch 6, 15, 310, 110
  caption "Search Phone Number List"
  ltext "Area Code",-1, 15,5,40,15
  scode as edittext 603,60,5,20,15
  ltext "Baud Rate",-1, 85,5,40,15
  srate as edittext 604,130,5,30,15
  ltext "State    ",-1,165,5,40,15
  sstate as edittext 605,210,5,20,15
  groupbox "Phone Number       City                              State      Supported Baud Rates",-1,10,20,290,65
  sresult as listbox 507,15,30,280,60,LBS_STANDARD+LBS_USETABSTOPS
  pushbutton "Cancel",IDCANCEL,100,90,50,15
  defpushbutton "Search",606,160,90,50,15
end dialog

dialog ServicesHelp 6, 15, 194, 144
  caption "About Script Generator"
  defpushbutton "OK", IDOK, 72, 122, 50, 14
  groupbox "", -1, 4, 4, 185, 111
  ltext "Delphi Script Generator is used to automatically create a script to call Delphi.", -1, 10, 10, 170, 25
  ltext "Macro Keys are also defined with common Delphi Functions, Use the A,AC,AS,ASC button to toggle.", -1, 10, 35, 170, 25
  ltext "Fill in PIN, Password, Area Code, Number, Country Code, and Modem.", -1, 10, 60, 170, 25
  ltext "The search button allows you search for numbers from the Phone Number Database.", -1, 10, 85, 170, 25
end dialog

'--------------------------------------------------------------------------=[ Types        ]=--
type tabrecord
  tabs(1 to 3) as integer
end type

'--------------------------------------------------------------------------=[ Declarations ]=---
declare Sub SendDlgItemMessageText lib "user32" alias "SendDlgItemMessageA" (hwnd as integer, id as integer, message as integer, wparam as integer, lparam as string)
declare function SendDlgItemMessageInt  lib "user32" alias "SendDlgItemMessageA" (hwnd as integer, id as integer, message as integer, wparam as integer, lparam as long) as long
declare function SendDlgItemMessageTab Lib "User32" Alias "SendDlgItemMessageA" (Hwnd as integer, Id as integer, Msg as integer, Wparam as integer, lparam as TabRecord) as integer

'--------------------------------------------------------------------------=[ Variables    ]=---
dim search as phonesearch
dim searchname as string
dim sl as Generator
dim found as integer
dim count as integer
dim scriptname as string
dim cinfo as countryinfo
dim n as string
dim readstring as string

'--------------------------------------------------------------------------=[ Functions    ]=---
function GetUniqueScriptName(prefix as string) as string
  dim scrname as string
  scrname = ConfigScriptPath + "\" + prefix + ".QSC"
  dim i as integer
  i = 0
  do while exists(scrname)
    i = i + 1
    scrname = ConfigScriptPath + "\" + prefix + str(i) + ".QSC"
  loop
  GetUniqueScriptName = scrname
end function

function Generator.id(113) as integer
  dim help as ServicesHelp
  dialogbox help
end function

function Generator.id(112) as integer
  if (sl.service = 0) then searchname = ConfigScriptPath+"\delphi-s.dat"
  if (sl.service = 1) then searchname = ConfigScriptPath+"\delphi-t.dat"
  if (sl.areacode <> "") then search.scode = sl.areacode
  if dialogbox (search) = IDOK then
    if n <> "" then
      sl.areacode = left (n,3)
      sl.number   = mid  (n,5,8)
    end if
  end if
end function

function Generator.id(114) as integer
  if userid = "" then
    msgbox "You need to fill in your User ID."
    exit function
  end if

  if password = "" then
    msgbox "You need to fill in your password."
    exit function
  end if

  if (number = "") or (areacode = "") then
    msgbox "Your phone number data is incomplete."
    exit function
  end if

  if (country < 0) then
    msgbox "You need to pick a country."
    exit function
  end if

  DialogResult = IDOK
  n = spc(255)
  SendDlgItemMessageText (hwindow,105,CB_GETLBTEXT,sl.country,n)
end function

function phonesearch.id(507) as integer
  n = spc(255)
  SendDlgItemMessageText (hwindow,507,LB_GETTEXT,sresult,n)
  dialogresult = IDOK
end function

function phonesearch.id(606) as integer
  dim sendmess as integer, totalfound as integer
  dim sfound as boolean

  if not ((scode = "") and (srate = "") and (sstate = "")) then
    totalfound = 0
    sendmess = SendDlgItemMessageInt (hwindow,507,LB_RESETCONTENT,0,0)
    if exists (searchname) then
      open searchname for input as #1
      do while not (eof (1))
        sfound = false
        input #1,readstring
        if (scode <> "") then
          if (srate <> "") then
            if (sstate <> "") then
              if (left (readstring,3) = scode) and (instr (mid (readstring,38,23),srate) <> 0) and (mid (readstring,35,2) = sstate) then sfound = true
            else
              if (left (readstring,3) = scode) and (instr (mid (readstring,38,23),srate) <> 0) then sfound = true
            end if
          else
            if (sstate <> "") then
              if (left (readstring,3) = scode) and (mid (readstring,35,2) = sstate) then sfound = true
            else
              if (left (readstring,3) = scode) then sfound = true
            end if
          end if
        else
          if (srate <> "") then
            if (sstate <> "") then
              if (instr (mid (readstring,38,23),srate) <> 0) and (mid (readstring,35,2) = sstate) then sfound = true
            else
              if (instr (mid (readstring,38,23),srate) <> 0) then sfound = true
            end if
          else
            if (sstate <> "") then
              if (mid (readstring,35,2) = sstate) then sfound = true
            end if
          end if
        end if
        if sfound then
          readstring = left (readstring,12)+chr(9)+mid(readstring,14,20)+chr(9)+mid(readstring,35,2)+chr(9)+mid(readstring,38,25)
          addlistboxitem (hwindow,507,readstring)
          totalfound = totalfound + 1
          sfound = false
        end if
      loop
      close #1
    end if
    if totalfound = 0 then
      addlistboxitem (hwindow,507,"No Records Found Matching Search Criteria!")
    end if
  else
    msgbox "You must select an Area Code, Baud Rate, and/or State to search"
  end if
  scode = ""
  srate = ""
  sstate = ""
end function

'---------------------------------------------------------------------------=[ Subroutines  ]=-
sub Generator.init
  userid   = ""
  password = ""
  areacode = ""
  number   = ""
  for count = 1 to getmodemcount
    addcomboboxitem (hwindow,106,getmodemname (count - 1))
  next count
  modem = 0
  addcomboboxitem (hwindow,107,"SprintNet")
  addcomboboxitem (hwindow,107,"Tymnet")
  service = 0
  if getfirstcountry (cinfo) then
    do
      readstring = pad (cinfo.name,150)+pad(str(cinfo.countryid),5)+pad(str(cinfo.countrycode),5)
      addcomboboxitem (hwindow,105,readstring)
    loop until not (getnextcountry (cinfo))
  end if
end sub

sub phonesearch.init
  dim t as tabrecord, result1 as integer
  t.tabs(1) =  60
  t.tabs(2) =  140
  t.tabs(3) =  160
  result1 = SendDlgItemMessageTab (HWindow, 507, LB_SETTABSTOPS, 3, t)
end sub

sub CreateDELSPRScript
  print #1, "striphibit on"
  print #1, "delay 1"
  print #1, "send ""@D^M"""
  print #1, "timeout 5"
  print #1, "try1200:"
  print #1, "waitfor ""TERMINAL="""
  print #1, "timeout off"
  print #1, "send ""^M"""
  print #1, "waitfor ""@"""
  print #1, "send ""C DELPHI"""
  print #1, "waitfor ""Username: """
  print #1, "send lastconnectuserid"
  print #1, "waitfor ""Password: """
  print #1, "send lastconnectpassword"
  print #1,
  print #1, "catch err_timeout"
  print #1, "send"
  print #1, "goto try1200"
end sub

sub CreateDELTYMScript
  print #1, "striphibit on"
  print #1, "delay 5"
  print #1, "send ""o"""
  print #1, "waitfor ""please log in"""
  print #1, "send ""DELPHI"""
  print #1, "waitfor ""User name: """
  print #1, "send lastconnectuserid"
  print #1, "waitfor ""Password: """
  print #1, "send lastconnectpassword"
end sub

'---------------------------------------------------------------------------=[ Main         ]=-
MAIN:

if dialogbox(sl) = IDOK then
  scriptname = GetUniqueScriptName("delphi")
  open scriptname for output as #1
  if sl.service = 0 then CreateDELSPRScript
  if sl.service = 1 then CreateDELTYMScript
  close #1
  dim entry as phoneentry
  entry.name = "Delphi"
  entry.areacode = sl.areacode
  entry.number(1) = sl.number
  entry.userid = sl.userid
  entry.password = sl.password
  entry.scriptfile = scriptname
  entry.macrofile = "delphi.mac"
  entry.emulation = vt100
  entry.protocol = zmodem
  entry.iconrespath = "bbsicons.dll"
  entry.iconresid = 59
  entry.useareacountry = 1
  entry.tapidevice = getmodemname (sl.modem)
  entry.countryid   = val(mid(n,151,5))
  entry.countrycode = val(mid(n,156,5))
  if updatephoneentry (entry) then
    msgbox ("Delphi Entry Modified With New Information")
  else
    addphoneentry (entry)
    msgbox "Phone directory entry for Delphi created."
  end if
end if

catch err_fileopen
  msgbox "Could not create script: " + scriptname
  goto main