unit Unit101;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, DB, Wwdatsrc, FIBDataSet, pFIBDataSet, FIBDatabase,
  pFIBDatabase, StdCtrls, ExtCtrls, Registry, ComCtrls,
  fcProgressBar, wwdbdatetimepicker, Mask, wwdbedit, IniFiles, dxGDIPlusClasses;

const
  InputBoxMessage = WM_USER + 200;

type
  TfmConfigConexion = class(TForm)
    Panel1: TPanel;
    Label4: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    EditUsuario: TEdit;
    ComBoxConexion: TComboBox;
    EditContrasenia: TEdit;
    btnAceptar: TButton;
    btnCancelar: TButton;
    IBDatabase2: TpFIBDatabase;
    IBTransaction2: TpFIBTransaction;
    ibquery1: TpFIBDataSet;
    dsoibquery1: TwwDataSource;
    PopupMenu1: TPopupMenu;
    Abrirconexin1: TMenuItem;
    Nuevaconexin1: TMenuItem;
    ibquery2: TpFIBDataSet;
    Image1: TImage;
    procedure btnCancelarClick(Sender: TObject);
    procedure btnAceptarClick(Sender: TObject);
    procedure Conectar();
    procedure Abrirconexin1Click(Sender: TObject);
    procedure EditUsuarioKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ComBoxConexionKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EditContraseniaKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Nuevaconexin1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure InputBoxSetPasswordChar(var Msg: TMessage); message InputBoxMessage;
    procedure GrabarConexion();
  public
    { Public declarations }
    NombreEmpresa:String;
    procedure ObtenerConexiones();
    function GetRegistryData(RootKey: HKEY; Key, Value: string): variant;
    procedure SetRegistryData(RootKey: HKEY; Key, Value: string; RegDataType: TRegDataType; Data: variant);
  end;

var
  fmConfigConexion: TfmConfigConexion;
  G_UsuarioId:Integer;
  G_NomUsuario,G_PathBd,G_PassUsuario:String;
implementation



uses Unit102, Unit103, Unit1;{$R *.dfm}

procedure TfmConfigConexion.SetRegistryData(RootKey: HKEY; Key, Value: string; RegDataType: TRegDataType; Data: variant);
var
  Reg: TRegistry;
  s: string;
begin
  Reg := TRegistry.Create(KEY_WRITE);
  try
    Reg.RootKey := RootKey;
    if Reg.OpenKey(Key, True) then begin
      try
        if RegDataType = rdUnknown then
          RegDataType := Reg.GetDataType(Value);
        if RegDataType = rdString then
          Reg.WriteString(Value, Data)
        else if RegDataType = rdExpandString then
          Reg.WriteExpandString(Value, Data)
        else if RegDataType = rdInteger then
          Reg.WriteInteger(Value, Data)
        else if RegDataType = rdBinary then begin
          s := Data;
          Reg.WriteBinaryData(Value, PChar(s)^, Length(s));
        end else
          raise Exception.Create(SysErrorMessage(ERROR_CANTWRITE));
      except
        Reg.CloseKey;
        raise;
      end;
      Reg.CloseKey;
    end else
      raise Exception.Create(SysErrorMessage(GetLastError));
  finally
    Reg.Free;
  end;
end;


function TfmConfigConexion.GetRegistryData(RootKey: HKEY; Key, Value: string): variant;
var
  Reg: TRegistry;
  RegDataType: TRegDataType;
  DataSize, Len: integer;
  s: string;
label cantread;
begin
  Reg := nil;
  try
    Reg := TRegistry.Create(KEY_QUERY_VALUE);
    Reg.RootKey := RootKey;
    if Reg.OpenKeyReadOnly(Key) then begin
      try
        RegDataType := Reg.GetDataType(Value);
        if (RegDataType = rdString) or
           (RegDataType = rdExpandString) then
          Result := Reg.ReadString(Value)
        else if RegDataType = rdInteger then
          Result := Reg.ReadInteger(Value)
        else if RegDataType = rdBinary then begin
          DataSize := Reg.GetDataSize(Value);
          if DataSize = -1 then goto cantread;
          SetLength(s, DataSize);
          Len := Reg.ReadBinaryData(Value, PChar(s)^, DataSize);
          if Len <> DataSize then goto cantread;
          Result := s;
        end else
cantread:
          raise Exception.Create(SysErrorMessage(ERROR_CANTREAD));
      except
        s := ''; // Deallocates memory if allocated
        Reg.CloseKey;
        raise;
      end;
      Reg.CloseKey;
    end else
      raise Exception.Create(SysErrorMessage(GetLastError));
  except
    Reg.Free;
    raise;
  end;
  Reg.Free;
end;

procedure TfmConfigConexion.ObtenerConexiones();
var
Registry :Tregistry;
Values,Names : TStringList;
i:integer;
Found: boolean;
begin
Registry := TRegistry.Create; // default root key is HKEY_CURRENT_USER
Names := TStringList.Create;
Values := TStringList.Create;

    Registry.RootKey := HKEY_LOCAL_MACHINE; // want a new root key
    Registry.OpenKey('\SOFTWARE\Microsip\Conexiones', False); // no create
    Registry.GetKeyNames(Names);
    I := 0;
    Found := False;

    while (I <= Names.Count-1) do
    begin
      ComBoxConexion.items.Add(Names[I]);
      if I = 0 then
        begin
          ComBoxConexion.Text := Names[0];
        end;
      Found := True;
      Inc(I);
    end;

    if not Found then
      ShowMessage('No existen Conexiones!')
     else


  Values.Free;
  Names.Free;
  Registry.Free;  // destroy the instance
  ComBoxConexion.ItemIndex := 0;
end;

procedure TfmConfigConexion.Conectar();
var
Temp,REMOTO,s: string;
NOMBD, BASE, BASECONFIG, USER, PASS, TIPO_ACCESO :STRING;
begin
  TRY
  BEGIN
    //////////////// Conexion METADATOS
    REMOTO := '';
    IF IBDatabase2.Connected = TRUE THEN
      IBDatabase2.Connected := FALSE;

    if IBDatabase2.Connected = false then
    begin
      TEMP:=GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\Microsip\Conexiones\'+ComBoxConexion.Text,'Tipo de Acceso');
      if temp = '0' then
      begin
        REMOTO := GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\Microsip\Conexiones\'+ComBoxConexion.Text,'Nombre del servidor');
        REMOTO := REMOTO + ':';
      end;
      TEMP:='System/Config.fdb';
      TEMP:=GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\Microsip\Conexiones\'+ComBoxConexion.Text,'Directorio de Datos')+TEMP;
      IBDatabase2.dbParams.Clear;
      IBDatabase2.DatabaseName := REMOTO+TEMP;
      TEMP:=fmConfigConexion.EditUsuario.Text;
      IBDatabase2.dbParams.Add('user_name='+temp);
      if uppercase(TEMP) <> 'SYSDBA' then
        IBDatabase2.dbParams.Add('sql_role_name=USUARIO_MICROSIP');
      TEMP:=fmConfigConexion.EditContrasenia.Text;
      IBDatabase2.dbParams.Add('password='+temp);
      IBDatabase2.useLoginPrompt := false;
      TRY
      IBDatabase2.Connected := true;
      EXCEPT
            on e:Exception do
            begin
              if pos('Your user name and password are not defined', E.Message)<>0 then
                MessageDlg('El usuario o la contraseña no son válidos.' , mtError,[mbOK],0)
              else if pos('Unable to complete network request', E.Message)<>0 then
                       MessageDlg('No se puede hacer contacto con el servidor.' , mtError,[mbOK],0)
                   else if pos('I/O error for file', E.Message)<>0 then
                           MessageDlg('La carpeta de datos Microsip no es válida.' , mtError,[mbOK],0)
                        else if pos('load library fbclient', E.Message)<>0 then
                                MessageDlg('No es posible cargar la librería fbclient.dll. ' + #13 + 'Intente copiarla a la carpeta del programa e intente nuevamente.' , mtError,[mbOK],0)
                             else  MessageDlg('Ha ocurrido un error al intentarse conectar a la base de datos. ' + #13 + 'Error: ' + E.Message, mtError,[mbOK],0);
              EditUsuario.SetFocus;
              Exit;
            end

      END;

      IbTransaction2.Active := true;
    end;

        IBQuery1.Close;
        IbQuery1.SelectSQL.Clear;
        if uppercase(EditUsuario.Text) = 'SYSDBA' thEN
        begin
        S:='SELECT NOMBRE_CORTO FROM EMPRESAS ORDER BY NOMBRE_CORTO';
        ibquery1.SelectSQL.Add(S);
        end
        else
        begin
        IBQuery1.Close;
        IbQuery1.SelectSQL.Clear;
        S:='SELECT ACCESO_EMPRESAS FROM USUARIOS WHERE NOMBRE = :NOM';
        ibquery1.SelectSQL.Add(S);
        IBQUERY1.ParamByName('NOM').ASSTRING := uppercase(EditUsuario.TEXT);
        IBQUERY1.CloseOpen(FALSE);
        TIPO_ACCESO := IBQuery1.Fieldbyname('ACCESO_EMPRESAS').asstring;
        if TIPO_ACCESO = 'T' then
            S:='SELECT NOMBRE_CORTO FROM EMPRESAS ORDER BY NOMBRE_CORTO'
        else
            S:='SELECT C.NOMBRE_CORTO FROM USUARIOS A INNER JOIN EMPRESAS_USUARIOS B ON (A.USUARIO_ID = B.USUARIO_ID) INNER JOIN EMPRESAS C ON (B.EMPRESA_ID = C.EMPRESA_ID) WHERE A.NOMBRE = :NOM ORDER BY NOMBRE_CORTO';

        IBQuery1.Close;
        IbQuery1.SelectSQL.Clear;
        ibquery1.SelectSQL.Add(S);
        if TIPO_ACCESO <> 'T' then
          IBQUERY1.ParamByName('NOM').ASSTRING := uppercase(EditUsuario.TEXT);
        end;
        IBQUERY1.CloseOpen(FALSE);

//***************************************ARREGLAR TODAS LAS EMPRESAS IF EMPTY
    if ibquery1.IsEmpty then
    begin
      ibquery2.Close;
      ibquery2.SelectSQL.Clear;
      ibquery2.SelectSQL.Add('SELECT ACCESO_EMPRESAS FROM USUARIOS');
      ibquery2.SelectSQL.Add('WHERE NOMBRE =:NOM');
      IBQUERY2.ParamByName('NOM').AsString := uppercase(EditUsuario.TEXT);
      ibquery2.OPEN;
      if ibquery2.FieldByName('ACCESO_EMPRESAS').AsString = 'T' then
      begin
        ibquery2.Close;
        ibquery2.SelectSQL.Clear;
        ibquery2.SelectSQL.Add('SELECT NOMBRE_CORTO FROM EMPRESAS');
        ibquery2.OPEN;
        fmEmpresas.showmodal;
      end
      else
      begin
        MessageDlg('No existen empresas declaradas.', mtInformation, [mbOk], 0);
        ibdatabase2.Connected := false;
        exit;
      end;
    end
    else
      fmEmpresas.showmodal;

    /////////////// CONEXION A BASE DE DATOS CON API
    //NombreEmpresa := ibquery1.fieldbyname('NOMBRE_CORTO').ASSTRING;

    IF (NombreEmpresa <> '_NINGUNA_') AND (NombreEmpresa <> '')THEN
    BEGIN
      With form1 do
      begin
        //*** CONEXION A BASE DE DATOS SIN API ***//
        NOMBD := '';
        BASE:='';
        USER:='';
        PASS:='';
        REMOTO := '';
        IF IBDatabase1.Connected = TRUE THEN
         IBDatabase1.Connected := FALSE;

        if IBDatabase1.Connected = false then
        begin
          TEMP:=GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\Microsip\Conexiones\'+ComBoxConexion.Text,'Tipo de Acceso');
          if temp = '0' then
          begin
            REMOTO := GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\Microsip\Conexiones\'+ComBoxConexion.Text,'Nombre del servidor');
            REMOTO := REMOTO + ':';
          end;
          NOMBD:= NombreEmpresa + '.fdb';
          NOMBD:= GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\Microsip\Conexiones\'+ComBoxConexion.Text,'Directorio de Datos') + NOMBD;
          BASE := REMOTO + NOMBD;
          G_PathBd := BASE;
          IBDatabase1.dbParams.Clear;
          IBDatabase1.DatabaseName := BASE;
          USER:= fmConfigConexion.EditUsuario.Text;
          IBDatabase1.dbParams.Add('user_name='+USER);
          PASS:=fmConfigConexion.EditContrasenia.Text;
          IBDatabase1.dbParams.Add('password='+PASS);
          if uppercase(USER) <> 'SYSDBA' then
            IBDatabase1.dbParams.Add('sql_role_name=USUARIO_MICROSIP');
          IBDatabase1.useLoginPrompt := false;
          TRY
          IBDatabase1.Connected := true;
          EXCEPT
            on e:Exception do
            begin
              if pos('Your user name and password are not defined', E.Message)<>0 then
                MessageDlg('El usuario o la contraseña no son válidos.' , mtError,[mbOK],0)
              else if pos('Unable to complete network request', E.Message)<>0 then
                       MessageDlg('No se puede hacer contacto con el servidor.' , mtError,[mbOK],0)
                   else if pos('I/O error for file', E.Message)<>0 then
                           MessageDlg('La carpeta de datos Microsip no es válida.' , mtError,[mbOK],0)
                        else if pos('load library fbclient', E.Message)<>0 then
                                MessageDlg('No es posible cargar la librería fbclient.dll. ' + #13 + 'Intente copiarla a la carpeta del programa e intente nuevamente.' , mtError,[mbOK],0)
                             else  MessageDlg('Ha ocurrido un error al intentarse conectar a la base de datos. ' + #13 + 'Error: ' + E.Message, mtError,[mbOK],0);
              EditUsuario.SetFocus;
              Exit;
            end
          END;

          IF IBDatabase1.Connected = TRUE THEN
          begin
            StatusBar1.Panels[0].Text := 'Conectado a << ' + NombreEmpresa + ' >>';
            StatusBar1.Panels[1].Text := uppercase(EditUsuario.TEXT);
            StatusBar1.Hint := Base;
            Panel1.Enabled:=True;
            trTrans.Active := true;
          end
          else
            StatusBar1.Panels[0].Text  := 'Error al conectarse a la base de Microsip.';
        end;
        //Hasta aqui conexión sin API


        //*** CONEXION A BASE DE DATOS CON API ***//
{        NOMBD := '';
        BASE:='';
        USER:='';
        PASS:='';
        REMOTO := '';

        TEMP:=GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\Microsip\Conexiones\'+ComBoxConexion.Text,'Tipo de Acceso');
        if temp = '0' then
        begin
          REMOTO := GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\Microsip\Conexiones\'+ComBoxConexion.Text,'Nombre del servidor');
          REMOTO := REMOTO + ':';
        end;
        NOMBD:= NombreEmpresa + '.fdb';
        NOMBD:= GetRegistryData(HKEY_LOCAL_MACHINE,'\SOFTWARE\Microsip\Conexiones\'+ComBoxConexion.Text,'Directorio de Datos') + NOMBD;
        BASE := REMOTO + NOMBD;
        G_PathBd := BASE;
        USER:= fmConfigConexion.EditUsuario.Text;
        PASS:=fmConfigConexion.EditContrasenia.Text;

          HANDLE1 := NewDB();
          HDTRN := NewTrn (Handle1,3);

          IF DBConnect(HANDLE1, PCHAR(BASE), PCHAR(USER), PCHAR(PASS)) = 0 THEN
          BEGIN
            StatusBar1.Panels[0].Text := 'Conectado a << ' + NombreEmpresa + ' >>';
            StatusBar1.Panels[1].Text := uppercase(EditUsuario.TEXT);
            StatusBar1.Hint := Base;
            Panel1.Enabled:=True;

            //Conectar IBDatabase1 para al VerifDerUsuario pruebe si el usuario tiene permisos
            IBDatabase1.dbParams.Clear;
            IBDatabase1.DatabaseName := BASE;
            IBDatabase1.DBParams.Add('user_name='+USER);
            IBDatabase1.DBParams.Add('password='+PASS);
            if uppercase(USER) <> 'SYSDBA' then
              IBDatabase2.dbParams.Add('sql_role_name=USUARIO_MICROSIP');
            IBDatabase1.UseLoginPrompt := false;
            IBDatabase1.Connected := true;
            trTrans.Active := true;
            trTrans2.Active := true;
            //ibdatabase2.Connected := false; //se usuará para pantalla permisos de usuarios
            VerifDerUsuario(BASE,USER,PASS);
          END
          ELSE
            StatusBar1.Panels[0].Text := 'Error número: ' + inttostr(GetLastErrorCode) + '. Al conectarse a la base de Microsip.';
        //Hasta aqui conexión con API
}
      end; //With form1
    END;
  END
  EXCEPT
  BEGIN
    if IBDatabase2.Connected then
      IBDatabase2.Connected := false;
    if Form1.IBDatabase1.Connected then
      Form1.IBDatabase1.Connected := false;
    MessageDlg('El usuario ó la contraseña no son válidos, verifiquelos.', mtError, [mbOk], 0);
  END;
  END;//FIN DE TRY
end;

procedure TfmConfigConexion.btnAceptarClick(Sender: TObject);
begin
  if (EditUsuario.text <> '') and (EditContrasenia.Text <> '') then
  begin
    if uppercase(EditUsuario.TEXT) = 'SYSDBA' then
    begin
      Conectar();
      if Form1.IBDatabase1.Connected then
      begin
        G_UsuarioId := 0;
        G_NomUsuario := 'SYSDBA';
        G_PassUsuario := EditContrasenia.Text;
        hide;
        GrabarConexion();
        form1.Show;
      end;
    end
    else
    begin
      Conectar();
      if Form1.IBDatabase1.Connected then
      begin
        IBQuery1.Close;
        IBQuery1.SelectSQL.Clear;
        IBQuery1.SelectSQL.Add('SELECT USUARIO_ID,NOMBRE FROM USUARIOS');
        IBQuery1.SelectSQL.Add('WHERE NOMBRE =:NOM');
        IBQuery1.ParamByName('NOM').AsString := uppercase(EditUsuario.TEXT);
        IBQuery1.Open;
        if IBQuery1.FieldByName('USUARIO_ID').AsInteger <> 0 then
        begin
          G_UsuarioId := IBQuery1.FieldByName('USUARIO_ID').AsInteger;
          G_NomUsuario := IBQuery1.FieldByName('NOMBRE').AsString;
          G_PassUsuario := EditContrasenia.Text;
          Hide;
          GrabarConexion();
          Form1.Show;
        end
        else
          MessageDlg('El usuario ' + EditUsuario.TEXT + ' no existe en la base de datos Microsip.', mtInformation, [mbOk], 0);
      end;
    end;
  end
  else
    MessageDlg('Especifíque un usuario y una contraseña.', mtInformation, [mbOk], 0);
end;

procedure TfmConfigConexion.btnCancelarClick(Sender: TObject);
begin
  application.Terminate;
end;

procedure TfmConfigConexion.Abrirconexin1Click(Sender: TObject);
begin
  fmConexion.Modo := 'A';
  fmConexion.NombreConexion := ComBoxConexion.Text;
  fmConexion.Caption := 'Abrir conexión';
  fmConexion.ShowModal;
end;

procedure TfmConfigConexion.Nuevaconexin1Click(Sender: TObject);
begin
  fmConexion.Modo := 'I';
  fmConexion.Caption := 'Nueva conexión';
  fmConexion.ShowModal;
end;

procedure TfmConfigConexion.EditUsuarioKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
if key = vk_return then
  ComBoxConexion.SetFocus;
end;

procedure TfmConfigConexion.ComBoxConexionKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
if key = vk_return then
  EditContrasenia.SetFocus;
end;

procedure TfmConfigConexion.EditContraseniaKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
if key = vk_return then
  btnAceptar.SetFocus;
end;


procedure TfmConfigConexion.InputBoxSetPasswordChar(var Msg: TMessage);
var
  hInputForm, hEdit, hButton: HWND;
begin
  hInputForm := Screen.Forms[0].Handle;
  if (hInputForm <> 0) then
  begin
    hEdit := FindWindowEx(hInputForm, 0, 'TEdit', nil);
    {
      // Change button text:
      hButton := FindWindowEx(hInputForm, 0, 'TButton', nil);
      SendMessage(hButton, WM_SETTEXT, 0, Integer(PChar('Cancel')));
    }
    SendMessage(hEdit, EM_SETPASSWORDCHAR, Ord('*'), 0);
  end;
end;

procedure TfmConfigConexion.FormCreate(Sender: TObject);
var
  ArchivoIni:TIniFile;
  PathIni:String;
  Item:Integer;
begin
  PathIni := ExtractFilePath(Application.ExeName) + '\ConfigMG.ini';
  ArchivoIni := TIniFile.Create(PathIni);
  ObtenerConexiones();
  if FileExists(PathIni) then
  begin
    EditUsuario.Text := ArchivoIni.ReadString('CONEXION','USUARIO','SYSDBA');
    Item := ArchivoIni.ReadInteger('CONEXION','CONEXION',0);
    if Item > ComBoxConexion.Items.Count then
      ComBoxConexion.ItemIndex := 0
    else
      ComBoxConexion.ItemIndex := Item;
  end
  else
  begin
    ArchivoIni.WriteString('CONEXION','USUARIO','SYSDBA');
    ArchivoIni.WriteInteger('CONEXION','CONEXION',0);
  end;

  ArchivoIni.Free;
end;

procedure TfmConfigConexion.GrabarConexion();
var
  ArchivoIni:TIniFile;
  PathIni:String;
begin
  Try
  begin
    PathIni := ExtractFilePath(Application.ExeName) + '\ConfigMG.ini';
    ArchivoIni := TIniFile.Create(PathIni);
    ArchivoIni.WriteString('CONEXION','USUARIO',EditUsuario.Text);
    ArchivoIni.WriteInteger('CONEXION','CONEXION',ComBoxConexion.ItemIndex);
  end
  finally
    ArchivoIni.Free;
  end;
end;

end.
