viernes, 17 de abril de 2015

fecha a MySql formatear fecha

uses DateUtils

var
  myDate : TDateTime;

begin
  // Set up our TDateTime variable with a full date and time :
  // 5th of June 2000 at 01:02:03.004  (.004 milli-seconds)
  myDate := EncodeDateTime(2000, 6, 5, 1, 2, 3, 4);

  // Date only - numeric values with no leading zeroes (except year)
  ShowMessage('              d/m/y = '+
              FormatDateTime('d/m/y', myDate));

  // Date only - numeric values with leading zeroes
  ShowMessage('           dd/mm/yy = '+
              FormatDateTime('dd/mm/yy', myDate));

  // Use short names for the day, month, and add freeform text ('of')
  ShowMessage('  ddd d of mmm yyyy = '+
              FormatDateTime('ddd d of mmm yyyy', myDate));

  // Use long names for the day and month
  ShowMessage('dddd d of mmmm yyyy = '+
              FormatDateTime('dddd d of mmmm yyyy', myDate));

  // Use the ShortDateFormat settings only
  ShowMessage('              ddddd = '+
              FormatDateTime('ddddd', myDate));

  // Use the LongDateFormat settings only
  ShowMessage('             dddddd = '+
              FormatDateTime('dddddd', myDate));

  // Use the ShortDateFormat + LongTimeFormat settings
  ShowMessage('                  c = '+
              FormatDateTime('c', myDate));
end;



o por ejemplo en una QUERY


  SQLQuery:='SELECT sum(CAST(metros AS UNSIGNED)) as metros FROM records ';
  SQLQuery:= SQLQuery +'where ';
  SQLQuery:= SQLQuery +'localizadorid="'+localizadores[i]+'" ';
  SQLQuery:= SQLQuery +'and contacto="1" ';
  SQLQuery:= SQLQuery +'and fecha="'+FormatDateTime('yyyy-mm-dd', now-1)+'" ';




// now-1   es el dia de ayer para anteayer seria now-2

.

delphi listar archivos y directorios

 function TForm1.ListaDirectorios(directorioPadre: string) : TStringList;
  var
    sr: TSearchRec;
  begin
    Result := TStringList.Create;
    if FindFirst(directorioPadre + '*', faDirectory, sr) = 0 then
    repeat
      if (sr.Attr = faDirectory) then
        Result.Add(directorioPadre + sr.Name);
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
 
  function TForm1.ListaArchivos(directorioPadre: string) : TStringList;
  var
    sr: TSearchRec;
  begin
    Result := TStringList.Create;
    if FindFirst(directorioPadre + '*', faAnyFile, sr) = 0 then
      repeat
        if (sr.Attr and faDirectory = 0) or (sr.Name <> '.')
          and (sr.Name <> '..') then
            Result.Add(directorioPadre + sr.Name);
      until FindNext(sr) <> 0;
    FindClose(sr);
  end;
 
    
     // Llamando a las funciones anteriores
 procedure TForm1.Button1Click(Sender: TObject);
  begin
    ListBox1.Items := ListaDirectorios('C:\');
    ListBox2.Items := ListaArchivos('C:\');
  end;

delphi borrar fichero

procedure TForm1.Button1Click(Sender: TObject);
begin

  if FileExists('c:\borrar.txt') then
    DeleteFile('c:\borrar.txt');

end;

delphi tamaño de un fichero

procedure TForm1.Button1Click(Sender: TObject);
var
  F: File of byte;
begin
  AssignFile( F, 'c:\ftp2.bat' );
  Reset( F );
  ShowMessage( IntToStr( FileSize( F ) ) + ' bytes' );
  CloseFile( F );

end;







.

domingo, 12 de abril de 2015

delphi try catch global en el form

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure GlobalExceptionHandler(Sender: TObject; E: Exception);
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }


  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//***********************************************************************
procedure TForm1.Button1Click(Sender: TObject);
var
i,j: integer;
begin

  j:=0;
  i:=10 div j;

end;

//***********************************************************************
procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnException := GlobalExceptionHandler;
end;

//***********************************************************************
procedure TForm1.GlobalExceptionHandler(Sender: TObject; E: Exception);
var
fic: textfile;
begin

  AssignFile (fic,'logerrores.txt');
  if FileExists('logerrores.txt')=false then
  begin
    ReWrite(fic);
  end
  else
  begin
    Append(fic);
  end;

  writeln(fic,datetostr(now()) + ' ' + timetostr(now()));
  writeln(fic,'-------------------------------------------------------------------');
  writeln(fic,'Exception class name = '+E.ClassName);
  writeln(fic,'Exception message = '+E.Message);
  writeln(fic,'');  CloseFile (fic);

end;

end.

delphi try catch

var
fic: textfile;


(...)
 
try
  j:=0;
  i:=1 div j;

  except
  on E : Exception do
  begin

  AssignFile (fic,'logerrores.txt');

  if FileExists('logerrores.txt')=false then
  begin
    ReWrite(fic);
  end
  else
  begin
    Append(fic);
  end;

  writeln(fic,datetostr(now()) + ' ' + timetostr(now()));
  writeln(fic,'-------------------------------------------------------------------');
  writeln(fic,'Exception class name = '+E.ClassName);
  writeln(fic,'Exception message = '+E.Message);
  writeln(fic,'');
  CloseFile (fic);
  end;


.

jueves, 2 de abril de 2015

espera a que termine shellexecute


procedure ExecuteAndWait(const aCommando: string);


 (...)


//*****************
procedure TForm1.ExecuteAndWait(const aCommando: string);
var
  tmpStartupInfo: TStartupInfo;
  tmpProcessInformation: TProcessInformation;
  tmpProgram: String;
begin
  tmpProgram := trim(aCommando);
  FillChar(tmpStartupInfo, SizeOf(tmpStartupInfo), 0);
  with tmpStartupInfo do
  begin
    cb := SizeOf(TStartupInfo);
    wShowWindow := SW_HIDE;
  end;

  if CreateProcess(nil, pchar(tmpProgram), nil, nil, true, CREATE_NO_WINDOW,
    nil, nil, tmpStartupInfo, tmpProcessInformation) then
  begin
    // loop every 10 ms
    while WaitForSingleObject(tmpProcessInformation.hProcess, 10) > 0 do
    begin
      Application.ProcessMessages;
    end;
    CloseHandle(tmpProcessInformation.hProcess);
    CloseHandle(tmpProcessInformation.hThread);
  end
  else
  begin
    RaiseLastOSError;
  end;
end;


(...)

//**********************************************
procedure TForm1.Button1Click(Sender: TObject);
var
aux: string;
begin

aux:='C:\Users\Pau\Desktop\blat.exe -server smtp.1und1.de -port 587 -f "root@mgflotas.com" -to "informaticoalicante@gmail.com" -subject "AVISO MGFLOTAS " -body "PAU" -u root@mgflotas.com -pw 91919191aA -html';
ExecuteAndWait(aux);

end;