home *** CD-ROM | disk | FTP | other *** search
/ PC Online 1997 January / PCO0197.ISO / filesbbs / os2 / inadv095.arj / QIMPORT.CMD < prev    next >
Encoding:
Text File  |  1996-08-14  |  4.2 KB  |  179 lines
  1. /*
  2. ------------------------
  3. Test Quicklist routines
  4. ------------------------
  5. */
  6.  
  7. TEMPFILE = "quicklst.txt"
  8.  
  9. say "Trying to load/register Internet Adventurer REXX API"
  10. if RxFuncQuery("IARX_Register") <> 0 then do
  11.    rc = RxFuncAdd("IARX_Register","IA_UTILS","IARX_Register")
  12.    if rc <> 0 then do
  13.       say "-------------------------------------"
  14.       say "Error loading Internet Adventurer API"
  15.       say "-------------------------------------"
  16.       exit(1)
  17.    end
  18. end
  19.  
  20. rc = IARX_Register();
  21. if rc then do
  22.    say "-------------------------------------"
  23.    say "Error loading Internet Adventurer API"
  24.    say "-------------------------------------"
  25.    exit(1)
  26. end
  27.  
  28. say "Opening database"
  29. ptr = IARX_QOpenDatabase();
  30. if length(ptr) > 0 then do
  31.    say "-------------------------------------"
  32.    say "Opening database gave this:" ptr
  33.    say "-------------------------------------"
  34.    exit(1)
  35. end
  36.  
  37. say "Database opened"
  38.  
  39. signal on novalue name handlenovalue
  40. signal on error   name handleerror
  41. signal on syntax  name handleerror
  42.  
  43. say "-- Importing..."
  44. level = 0
  45. parent = 0;
  46. gotstring = 0
  47.  
  48. parentid.1 = 0
  49.  
  50. do until lines(tempfile) = 0
  51.    if gotstring = 0 then
  52.       str = linein(TEMPFILE)
  53.  
  54.    gotstring = 0
  55.  
  56.    ok = 0
  57.  
  58.    do until ok = 1 | lines(TEMPFILE) = 0
  59.       if pos('"', str) = 0 then
  60.          ok = 1
  61.       else do
  62.          if right(str, 1) <> '"' then do
  63.             str1 = linein(TEMPFILE)
  64.             str = str || D2C(13) || D2C(10) || str1
  65.          end
  66.          else
  67.             ok = 1
  68.       end
  69.    end
  70.  
  71.    titlepos = pos("Title:", str)
  72.    if (titlepos <> 0) then do
  73. /*      say "Level" titlepos substr(str, titlepos+8, length(str)-titlepos-8) */
  74.  
  75.       str1 = linein(TEMPFILE)
  76.  
  77.       titlepos1 = pos("Title:", str1)
  78.  
  79.       if titlepos1 <> 0 then do
  80.          /* If we found a title here - then it's because this is a folder */
  81.  
  82.          q.id = 0
  83.          q.parent = parentid.titlepos
  84.          q.children = 0
  85.          q.type = 0
  86.          q.title = substr(str, titlepos+8, length(str)-titlepos-8)
  87.          q.nick = ""
  88.          q.url = ""
  89.  
  90.          rc = IARX_QCreate("q");
  91.  
  92.          if (rc = 0) then do
  93.             say 'The group "' || q.title || '" was created ok' 
  94.          end
  95.          else do
  96.             say 'Error' rc 'creating group "' || q.title || '"' 
  97.          end
  98.  
  99.          titlepos = titlepos + 1
  100.          parentid.titlepos = q.id
  101.  
  102.          str = str1;
  103.          gotstring = 1
  104.       end
  105.       else do
  106.          urlpos = pos("URL  :", str1)
  107.          if (titlepos <> 0) then do
  108. /*            say "URL:" substr(str1, urlpos+8, length(str1)-urlpos-8) */
  109.  
  110.             /* Now, read the nickname */
  111.             str2 = linein(TEMPFILE)
  112.  
  113.             nickpos = pos("Nick :", str2)
  114.  
  115.             q.id = 0
  116.             q.parent = parentid.titlepos
  117.             q.children = 0
  118.             q.type = 1
  119.             q.title = substr(str, titlepos+8, length(str)-titlepos-8)
  120.             q.nick = substr(str2, nickpos+8, length(str2)-nickpos-8)
  121.             q.url = substr(str1, urlpos+8, length(str1)-urlpos-8)
  122.    
  123.             rc = IARX_QCreate("q");
  124.             if (rc = 0) then do
  125.                say 'The item "' || q.title || '" was created ok' 
  126.             end
  127.             else do
  128.                say 'Error' rc 'creating item "' || q.title || '"' 
  129.             end
  130.  
  131.          end
  132.       end
  133.    end
  134. end
  135.  
  136. say "-- Importing finished"
  137.  
  138. say "Closing database"
  139. rc = IARX_QCloseDatabase()
  140.  
  141. rc = lineout(TEMPFILE)
  142.  
  143. say "Importing completed"
  144. exit(0)
  145.  
  146. -------------
  147. Handle errors
  148. -------------
  149. Upon entry to this function, the contents of the variables are:
  150. rc   - Error code
  151. sigl - Line number, error occured in.
  152.  
  153. Now we just display the error code and text followed by the
  154. source-line with the problem
  155. */
  156.  
  157. handleerror:
  158.  
  159. say "REXX Error" rc "in line" sigl ":" errortext(rc);
  160. say "-----";
  161. say "-----" sourceline(sigl);
  162. say "-----";
  163. rc = IARX_QCloseDatabase();
  164. exit;
  165.  
  166. /*
  167. ------------------------------
  168. Handle variables without value
  169. ------------------------------
  170. */
  171. handlenovalue:
  172.  
  173. say "REXX Error, trying to reference variable with no value in line" sigl;
  174. say "-----";
  175. say "-----" sourceline(sigl);
  176. say "-----";
  177. rc = IARX_QCloseDatabase();
  178. exit;
  179.