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
.
viernes, 17 de abril de 2015
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;
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;
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;
.
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.
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;
.
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;
Suscribirse a:
Entradas (Atom)