(* Collection of code snippets by Arne Vajhøj *)
(* (from articles on eksperten.dk / vajhoej.dk written sometime between 2004 and now) *)
[inherit('common', 'mysql', 'pmysql', 'pmysql2')]
program mysql(input, output);

%include 't1.inc'

procedure checkcon(con : mysql_ptr);

begin
   if con = 0 then begin
      writeln(pmysql_error(con));
      halt;
   end;
end;

procedure checkstmt(stmt : mysql_stmt_ptr; con : mysql_ptr);

begin
   if stmt = 0 then begin
      writeln(pmysql_error(con));
      halt;
   end;
end;

procedure checkstat(stat : integer; stmt : mysql_stmt_ptr);

begin
   if stat <> 0 then begin
      writeln(pmysql_stmt_error(stmt));
      halt;
   end;
end;

function connect(host, un, pw, db : pstr) : mysql_ptr;

var
   con : mysql_ptr;

begin
   con := pmysql_init;
   checkcon(con);
   con := pmysql_real_connect(con, host, un, pw, db);
   checkcon(con);
   connect := con;
end;

function t1_get_one(con : mysql_ptr; f2 : pstr) : integer;

var
   stmt : mysql_stmt_ptr;
   stat : integer;
   inparam : array[1..1] of mysql_bind;
   outparam : array[1..1] of mysql_bind;
   f1 : integer;

begin
   stmt := pmysql_stmt_init(con);
   checkstmt(stmt, con);
   stat := pmysql_stmt_prepare(stmt, 'SELECT f1 FROM t1 WHERE f2 = ?');
   checkstat(stat, stmt);
   pmysql_init_bind_string_in(inparam[1], f2);
   stat := pmysql_stmt_bind_param(stmt, inparam);
   checkstat(stat, stmt);
   stat := pmysql_stmt_execute(stmt);
   checkstat(stat, stmt);
   pmysql_init_bind_long(outparam[1], f1);
   stat := pmysql_stmt_bind_result(stmt, outparam);
   checkstat(stat, stmt);
   stat := pmysql_stmt_store_result(stmt);
   checkstat(stat, stmt);
   if pmysql_stmt_fetch(stmt) = 0 then begin
      t1_get_one := f1;
   end else begin
      writeln('Row not found');
      halt;
   end;
   pmysql_stmt_free_result(stmt);
end;

function t1_get_all(con : mysql_ptr; var buf : array[$L1..$U1:integer] of t1; bufsiz : integer) : integer;

var
   stmt : mysql_stmt_ptr;
   stat : integer;
   outparam : array[1..2] of mysql_bind;
   f1 : integer;
   f2 : longpstr(255);
   count : integer;

begin
   stmt := pmysql_stmt_init(con);
   checkstmt(stmt, con);
   stat := pmysql_stmt_prepare(stmt, 'SELECT f1,f2 FROM t1');
   checkstat(stat, stmt);
   stat := pmysql_stmt_execute(stmt);
   checkstat(stat, stmt);
   pmysql_init_bind_long(outparam[1], f1);
   pmysql_init_bind_string_out(outparam[2], f2);
   stat := pmysql_stmt_bind_result(stmt, outparam);
   checkstat(stat, stmt);
   stat := pmysql_stmt_store_result(stmt);
   checkstat(stat, stmt);
   count := 0;
   while pmysql_stmt_fetch(stmt) = 0 do begin
      count := count + 1;
      buf[count].f1 := f1;
      buf[count].f2 := stdstr(f2);
   end;
   pmysql_stmt_free_result(stmt);
   t1_get_all := count;
end;

procedure t1_put(con : mysql_ptr; f1 : integer; f2 : pstr);

var
   stmt : mysql_stmt_ptr;
   stat : integer;
   inparam : array[1..2] of mysql_bind;

begin
   stmt := pmysql_stmt_init(con);
   checkstmt(stmt, con);
   stat := pmysql_stmt_prepare(stmt, 'INSERT INTO t1 VALUES(?, ?)');
   checkstat(stat, stmt);
   pmysql_init_bind_long(inparam[1], f1);
   pmysql_init_bind_string_in(inparam[2], f2);
   stat := pmysql_stmt_bind_param(stmt, inparam);
   checkstat(stat, stmt);
   stat := pmysql_stmt_execute(stmt);
   checkstat(stat, stmt);
   if pmysql_stmt_affected_rows(stmt) <> 1 then begin
      writeln('INSERT did not insert 1 row');
      halt;
   end;
   pmysql_stmt_free_result(stmt);
end;

procedure t1_remove(con : mysql_ptr; f1 : integer);

var
   stmt : mysql_stmt_ptr;
   stat : integer;
   inparam : array[1..1] of mysql_bind;

begin
   stmt := pmysql_stmt_init(con);
   checkstmt(stmt, con);
   stat := pmysql_stmt_prepare(stmt, 'DELETE FROM t1 WHERE f1 = ?');
   checkstat(stat, stmt);
   pmysql_init_bind_long(inparam[1], f1);
   stat := pmysql_stmt_bind_param(stmt, inparam);
   checkstat(stat, stmt);
   stat := pmysql_stmt_execute(stmt);
   checkstat(stat, stmt);
   if pmysql_stmt_affected_rows(stmt) <> 1 then begin
      writeln('DELETE did not delete 1 row');
      halt;
   end;
   pmysql_stmt_free_result(stmt);
end;

procedure t1_dump(con : mysql_ptr);

const
   MAX_REC = 100;

var
   buf : array [1..MAX_REC] of t1;
   i, n : integer;

begin
   n := t1_get_all(con, buf, MAX_REC);
   for i := 1 to n do begin
      writeln('  ', buf[i].f1:1, ' ', buf[i].f2);
   end;
end;

var
   con : mysql_ptr;
   f1 : integer;

begin
   con := connect('localhost', 'root', '', 'test');
   f1 := t1_get_one(con, 'BB');
   writeln('one:');
   writeln('  ', f1:1);
   writeln('all:');
   t1_dump(con);   
   t1_put(con, 999, 'XXX');
   writeln('all after insert:');
   t1_dump(con);
   t1_remove(con, 999);
   writeln('all after delete:');
   t1_dump(con);
   pmysql_close(con);
end.