library ftp;

uses
{$IFDEF WIN32} FastShareMem, {$ENDIF}
  SysUtils, Classes, Controls, Rubies, uDefUtils, Pythia,
  NMFtp, SocketExtension, FTPHandle;

{$E so}

var
  sDirinfo: Tvalue;

function Dirinfo_alloc(real: TFTPDirectoryList): Tvalue;
var
  ary: Tvalue;
begin
  if real = nil then begin result := Qnil; Exit; end;
  ary := rb_ary_new;
  rb_ary_push(ary, ap_iStrings(real.Attribute, Qnil));
  rb_ary_push(ary, ap_iStrings(real.ModifDate, Qnil));
  rb_ary_push(ary, ap_iStrings(real.Name, Qnil));
  rb_ary_push(ary, ap_iStrings(real.Size, Qnil));
  result := rb_struct_alloc(sDirinfo, ary);
end;

const
  props: array[0..3] of PChar = (
    'attr',
    'date',
    'name',
    'size'
  );

procedure Init_Dirinfo;
var
  ary: Tvalue;
  i: Integer;
begin
  ary := rb_ary_new;
  rb_ary_push(ary, rb_str_new2('Dirinfo'));
  for i := low(props) to high(props) do
    rb_ary_push(ary, ap_String(props[i]));
  sDirinfo := rb_apply(ap_cStruct, rb_intern('new'), ary);
  rb_global_variable(@sDirinfo);
end;

function FTP_new(This: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := TNMFTP.Create(nil);
  real.ParseList := True;
  result := CompoAlloc(This, real);
  if @real.OnTransactionStart = nil then real.OnTransactionStart := handle.doTransactionStart ;
  if @real.OnTransactionStop  = nil then real.OnTransactionStop  := handle.doTransactionStop  ;
  Socket_setup(result, real);
  ap_obj_call_init(result, 0, nil);
end;

function FTP_chdir(This, dir: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.ChangeDir(dl_String(dir));
    GetSocketHandle.doSuccess(real, 'chdir');
  except
    GetSocketHandle.doFailure(real, 'chdir');
  end;
  result := This;
end;

function FTP_mkdir(This, dir: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.MakeDirectory(dl_String(dir));
    GetSocketHandle.doSuccess(real, 'mkdir');
  except
    GetSocketHandle.doFailure(real, 'mkdir');
  end;
  result := This;
end;

function FTP_rmdir(This, dir: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.RemoveDir(dl_String(dir));
    GetSocketHandle.doSuccess(real, 'rmdir');
  except
    GetSocketHandle.doFailure(real, 'rmdir');
  end;
  result := This;
end;

function FTP_delete(This, fname: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.Delete(dl_String(fname));
    GetSocketHandle.doSuccess(real, 'delete');
  except
    GetSocketHandle.doFailure(real, 'delete');
  end;
  result := This;
end;

function FTP_rename(This, from, tofn: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.Rename(dl_String(from), dl_String(tofn));
    GetSocketHandle.doSuccess(real, 'rename');
  except
    GetSocketHandle.doFailure(real, 'rename');
  end;
  result := This;
end;

function FTP_sendcmd(This, cmd: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.DoCommand(dl_String(cmd));
    GetSocketHandle.doSuccess(real, 'sendcmd');
  except
    GetSocketHandle.doFailure(real, 'sendcmd');
  end;
  result := This;
end;

function FTP_mode(This, vmode: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
  ch: Char;
  mode: Integer;
begin
  real := ap_data_get_struct(This);
  ch := NUM2CHR(vmode);
  case ch of
  'A', 'a': mode := MODE_ASCII;
  'I', 'i': mode := MODE_IMAGE;
  else
    mode := MODE_BYTE;
  end;
  try
    real.Mode(mode);
    GetSocketHandle.doSuccess(real, 'mode');
  except
    GetSocketHandle.doFailure(real, 'mode');
  end;
  result := This;
end;

function FTP_download(This, remot, local: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.Download(dl_String(remot), dl_String(local));
    GetSocketHandle.doSuccess(real, 'download');
  except
    GetSocketHandle.doFailure(real, 'download');
  end;
  result := This;
end;

function FTP_download_restore(This, remot, local: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.DownloadRestore(dl_String(remot), dl_String(local));
    GetSocketHandle.doSuccess(real, 'restore');
  except
    GetSocketHandle.doFailure(real, 'restore');
  end;
  result := This;
end;

function FTP_upload(This, local, remot: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.Upload(dl_String(local), dl_String(remot));
    GetSocketHandle.doSuccess(real, 'upload');
  except
    GetSocketHandle.doFailure(real, 'upload');
  end;
  result := This;
end;

function FTP_upload_append(This, local, remot: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.UploadAppend(dl_String(local), dl_String(remot));
    GetSocketHandle.doSuccess(real, 'upload_append');
  except
    GetSocketHandle.doFailure(real, 'upload_append');
  end;
  result := This;
end;

function FTP_upload_restore(This, local, remot, pos: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.UploadRestore(dl_String(local), dl_String(remot), FIX2INT(pos));
    GetSocketHandle.doSuccess(real, 'upload_restore');
  except
    GetSocketHandle.doFailure(real, 'upload_restore');
  end;
  result := This;
end;

function FTP_upload_unique(This, local: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.UploadUnique(dl_String(local));
    GetSocketHandle.doSuccess(real, 'upload_unique');
  except
    GetSocketHandle.doFailure(real, 'upload_unique');
  end;
  result := This;
end;

function FTP_dirlist(This: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.List;
    GetSocketHandle.doSuccess(real, 'dirlist');
  except
    GetSocketHandle.doFailure(real, 'dirlist');
  end;
  result := This;
end;

function FTP_get_dirinfo(This: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  result := Dirinfo_alloc(real.FTPDirectoryList);
end;

function FTP_reinit(This: Tvalue): Tvalue; cdecl;
var
  real: TNMFTP;
begin
  real := ap_data_get_struct(This);
  try
    real.ReInitialize;
    GetSocketHandle.doSuccess(real, 'reinit');
  except
    GetSocketHandle.doFailure(real, 'reinit');
  end;
  result := This;
end;

procedure Init_ftp; cdecl;
begin
  if ap_cSocket = 0 then ap_loaderror('undefined Phi::Socket class');

  Init_Dirinfo;

  eFTPError := rb_define_class_under(ap_mPhi, 'FTPError', ap_eStandardError);

  cFTP := DefinePersistentClass(ap_mPhi, TNMFTP, ap_cSocket, nil);

  rb_define_alias(cFTP, 'user', 'user_id');
  rb_define_alias(cFTP, 'user=', 'user_id=');
  rb_define_alias(cFTP, 'passwd', 'password');
  rb_define_alias(cFTP, 'passwd=', 'password=');

  rb_define_method(cFTP, 'chdir', @FTP_chdir, 1);
  rb_define_method(cFTP, 'mkdir', @FTP_mkdir, 1);
  rb_define_method(cFTP, 'rmdir', @FTP_rmdir, 1);
  rb_define_method(cFTP, 'delete', @FTP_delete, 1);
  rb_define_method(cFTP, 'rename', @FTP_rename, 2);
  rb_define_method(cFTP, 'sendcmd', @FTP_sendcmd, 1);
  rb_define_method(cFTP, 'mode', @FTP_mode, 1);
  rb_define_method(cFTP, 'download', @FTP_download, 2);
  rb_define_method(cFTP, 'download_restore', @FTP_download_restore, 2);
  rb_define_method(cFTP, 'upload', @FTP_upload, 2);
  rb_define_method(cFTP, 'upload_append', @FTP_upload_append, 2);
  rb_define_method(cFTP, 'upload_restore', @FTP_upload_restore, 3);
  rb_define_method(cFTP, 'upload_unique', @FTP_upload_unique, 1);
  rb_define_method(cFTP, 'dirlist', @FTP_dirlist, 0);
  rb_define_method(cFTP, 'reinit', @FTP_reinit, 0);
  DefineAttrGet(cFTP, 'dirinfo', FTP_get_dirinfo);

  rb_define_singleton_method(cFTP, 'new', @FTP_new, 0);
end;

exports
  Init_ftp;

end.
