home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PRECOM.ZIP / SAMPLE.ZIP / SQLSTUFF.MOD < prev    next >
Encoding:
Modula Implementation  |  1992-10-01  |  1.8 KB  |  89 lines
  1. IMPLEMENTATION MODULE SQLStuff;
  2. FROM SQLDA IMPORT sqlda,SQLVar,sqldaPtr,SQLHeader;
  3. FROM SQLCA IMPORT sqlca;
  4. FROM Storage IMPORT ALLOCATE,DEALLOCATE;
  5. FROM SQL IMPORT SQLGINTP;
  6. FROM Lib IMPORT Fill;
  7. IMPORT SQL;
  8. FROM FIO IMPORT File, StandardOutput,WrLn,WrStr,WrLngInt;
  9. CONST
  10.   DAVarSize  = SIZE(SQLVar);
  11.   DAHeaderSize = SIZE(SQLHeader);
  12.  
  13. PROCEDURE AllocSQLDA( VAR TheDA : sqldaPtr; NbrVars : CARDINAL);
  14. VAR
  15.  S : CARDINAL;
  16.  
  17. BEGIN
  18.   S := DAHeaderSize + (NbrVars * DAVarSize);
  19.   ALLOCATE(TheDA,S);
  20.   Fill(TheDA,S,0);
  21.   TheDA^.header.sqlaid := 'SQLDA  ';
  22.   TheDA^.header.sqln := NbrVars;
  23.   TheDA^.header.sqldabc := LONGINT(S);
  24.  
  25. END AllocSQLDA;
  26.  
  27.  
  28.  
  29. PROCEDURE WhatSize(Var : SQLVar) : CARDINAL;
  30. BEGIN
  31.   CASE Var.type OF
  32.     SQL.SQL_TYP_VARCHAR,
  33.     SQL.SQL_TYP_NVARCHAR,
  34.     SQL.SQL_TYP_LONG,
  35.     SQL.SQL_TYP_NLONG    : RETURN Var.len + SIZE(CARDINAL);
  36.   ELSE RETURN Var.len;
  37.   END; (* end of case *)
  38.  
  39. END WhatSize;
  40.  
  41.  
  42. PROCEDURE DeallocSQLDA(VAR TheDA : sqldaPtr);
  43. VAR
  44.  N : CARDINAL;
  45.  J : CARDINAL;
  46.  S : CARDINAL;
  47. BEGIN
  48.   N := CARDINAL(TheDA^.header.sqldabc);
  49.   Fill(TheDA,N,0);
  50.   DEALLOCATE(TheDA,N);
  51.   TheDA := NIL;
  52. END DeallocSQLDA;
  53.  
  54.  
  55. PROCEDURE DefaultErrorRoutine( Handle : CARDINAL; Msg : ARRAY OF CHAR;
  56.                                CA : sqlca);
  57.  
  58.   (* if the handle = 0 assume the standard output device *)
  59.  
  60. VAR
  61.   H : File;
  62.   L : CARDINAL;
  63.   ErrMsg : ARRAY[0..800] OF CHAR;
  64. BEGIN
  65.  IF Handle = 0
  66.    THEN H := StandardOutput;
  67.    ELSE H := Handle;
  68.  END;
  69.  
  70.  WrLn(H);
  71.  WrStr(H,' SQL ERROR - ');
  72.  WrLngInt(H,CA.sqlcode,3);
  73.  WrLn(H);
  74.  WrStr(H,Msg);
  75.  WrLn(H);
  76.  L := SIZE(ErrMsg);
  77.  SQLGINTP(L,60,CA,ErrMsg);
  78.  WrStr(H,ErrMsg);
  79.  WrLn(H);
  80.  WrStr(H,'   * * * * *');
  81.  WrLn(H);
  82.  
  83.  
  84. END DefaultErrorRoutine;
  85.  
  86.  
  87. BEGIN
  88.   SQLErrorHandler := DefaultErrorRoutine;
  89. END SQLStuff.