Buenas no soy programador delphi solo he encontrado un codigo que me interesa de un programa simple y me he bajado varias versiones de delphi para compilarlo pero me da este error Line too long 1023 characters he mirado cosas en google pero no doy con una solucion a ver si alguien se podria poner en contacto conmigo y si es posible via msn enviar mp y envio el correo por mp para enviar el archivo a ver si podemos dar con una solucion ami problema o si es mas practico pegar el codigo aqui lo dejo
Código:
unit UnitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Gauges, KAZip, Buttons, IniFiles, StdCtrls, crc, OleCtrls,
SHDocVw, ExtCtrls, Wininet, ImgBtn, ComCtrls, KAZipListView,ShlObj, ComObj,
ActiveX, SHDocVw_TLB, ShellAPI;
//SHDocVw_TLB;
type
TFMain = class(TForm)
Gauge1: TGauge;
Gauge2: TGauge;
KAZip1: TKAZip;
Image1: TImage;
Label3: TLabel;
ImgBtn1: TImgBtn;
ImgBtn2: TImgBtn;
ImgBtn3: TImgBtn;
ImgBtn4: TImgBtn;
Panel1: TPanel;
WebBrowser1: TWebBrowser;
ImgBtn5: TImgBtn;
Img_Btn_Modhost: TImgBtn;
procedure FormCreate(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImgBtn4Click(Sender: TObject);
procedure ImgBtn3Click(Sender: TObject);
procedure ImgBtn2Click(Sender: TObject);
procedure ImgBtn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ImgBtn5Click(Sender: TObject);
procedure Img_Btn_ModhostClick(Sender: TObject);
procedure WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Draging: Boolean;
X0, Y0: integer;
end;
var
FMain: TFMain;
MyDir: String;
th1, h1, GetCritical, UpdateSelf: cardinal;
USettings, Files : TStrings;
implementation
uses Frm2, Mod_host;
{$R *.dfm}
function ReplaceStr(const S, Srch, Replace: string): string;
var
I: Integer;
Source: string;
begin
Source := S;
Result := '';
repeat
I := Pos(Srch, Source);
if I>0 then
begin
Result := Result + Copy(Source, 1, I - 1) + Replace;
Source := Copy(Source, I + Length(Srch), MaxInt);
end
else
Result := Result + Source;
until I<= 0;
end;
function StrSearch(StartPos: Integer; const S, P: string): Integer;
type
TBMTable = array[0..255] of Integer;
var
Pos, lp, i: Integer;
BMT: TBMTable;
begin
for i := 0 to 255 do
BMT[i] := Length(P);
for i := Length(P) downto 1 do
if BMT[Byte(P[i])] = Length(P) then
BMT[Byte(P[i])] := Length(P) - i;
lp := Length(P);
Pos := StartPos + lp - 1;
while Pos <= Length(S) do
if P[lp] <> S[Pos] then
Pos := Pos + BMT[Byte(S[Pos])]
else if lp = 1 then
begin
Result := Pos;
Exit;
end
else
for i := lp - 1 downto 1 do
if P[i] <> S[Pos - lp + i] then
begin
Inc(Pos);
Break;
end
else if i = 1 then
begin
Result := Pos - lp + 1;
Exit;
end;
Result := 0;
end;
function Tokenize(Str: WideString; Delimiter: string): TStringList;
var
tmpStrList: TStringList;
tmpString, tmpVal: WideString;
DelimPos: LongInt;
begin
tmpStrList := TStringList.Create;
TmpString := Str;
DelimPos := 1;
while DelimPos > 0 do
begin
DelimPos := LastDelimiter(Delimiter, TmpString);
tmpVal := Copy(TmpString, DelimPos + 1, Length(TmpString));
if tmpVal <> '' then
tmpStrList.Add(tmpVal);
Delete(TmpString, DelimPos, Length(TmpString));
end;
Tokenize := tmpStrList;
end;
procedure ProcessFileList(flag : cardinal);
var
LSTFile:Tinifile;
Fcount,Len,i: cardinal;
TSTR:String;
begin;
LSTFile := Tinifile.Create(MyDir+'updates.lst');
FCount := LSTFile.ReadInteger('files','fcount',0);
if(FCount>0) then begin
for i:=1 to FCount-1 do begin
TSTR:=LSTFile.ReadString('files','F'+IntToStr(i),'');
len:=Length(TSTR);
case flag of
1: begin
if(TSTR[len]='c') then
Files.Add(TSTR);
end;
2: begin
if(TSTR[len]='n') then
Files.Add(TSTR);
end;
end;
end;
end;
LSTFile.Free;
end;
function HTTPGetFile(const fileURL, FileName: string): boolean;
const
BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: DWORD;
f: file;
sAppName: string;
begin
Result := False;
sAppName := ExtractFileName(Application.ExeName);
hSession := InternetOpen(PChar(sAppName),
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
hURL := InternetOpenURL(hSession, PChar(fileURL), nil, 0, 0, 0);
if hURL <> nil then begin
try
DeleteUrlCacheEntry(PChar(fileURL));
AssignFile(f, FileName);
Rewrite(f,1);
repeat
InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen);
BlockWrite(f, Buffer, BufferLen);
Application.ProcessMessages;
FMain.Gauge1.Progress:=FMain.Gauge1.Progress+BufferLen;
until
BufferLen = 0;
CloseFile(f);
Result := True;
finally
InternetCloseHandle(hURL);
end;
end;
finally
InternetCloseHandle(hSession);
end;
FMain.Gauge1.Progress:=0;
end;
procedure GenSelfUpdate(MyNameIs: string);
var BatchFile: TextFile;
BatchFileName: string;
begin
//Auto mise à jour by Stun
BatchFileName := GetCurrentDir + '\Update.bat';
AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);
Writeln(BatchFile,'title Mise à jour L2Updater');
Writeln(BatchFile,'@echo off');
Writeln(BatchFile,'cd "'+ GetCurrentDir +'"');
Writeln(BatchFile,'cls');
Writeln(BatchFile,'color 0A');
Writeln(BatchFile,'echo ###############################################################################');
Writeln(BatchFile,'echo #-----------------------------------------------------------------------------#');
Writeln(BatchFile,'echo # Mise a jour L2updater by Stun #');
Writeln(BatchFile,'echo #-----------------------------------------------------------------------------#');
Writeln(BatchFile,'echo ###############################################################################');
Writeln(BatchFile,'echo.');
Writeln(BatchFile,'echo.');
Writeln(BatchFile,'echo ///////////////////Fermeture du précédent updater en cours !\\\\\\\\\\\\\\\\\\\\');
Writeln(BatchFile,'echo.');
Writeln(BatchFile,'taskkill /F /IM ' + MyNameIs );
Writeln(BatchFile,'echo.');
Writeln(BatchFile,'echo.');
Writeln(BatchFile,'echo.');
Writeln(BatchFile,'echo //////////////////Mise a jour en cours, veuillez patienter...\\\\\\\\\\\\\\\\\\');
Writeln(BatchFile,'ping google.com -n 5 > nul');
if(FileExists(GetCurrentDir + '\'+ MyNameIs +'.New')=True) then begin
Writeln(BatchFile, 'del "updates.lst"');
Writeln(BatchFile, 'del "' + MyNameIs + '"');
Writeln(BatchFile,'rename "'+MyNameIs+ '.New" '+'"'+MyNameIs+'"');
end;
Writeln(BatchFile, 'start ' + MyNameIs );
Writeln(BatchFile, 'del "' + ExtractFileName(BatchFileName) + '"');
//Writeln(BatchFile, 'pause');
CloseFile(BatchFile);
end;
procedure GetUpdate;
var
LocalFile,RemoteFile:String;
i,CrcLocal:cardinal;
FileInfo:TStringlist;
begin
FMain.ImgBtn1.Visible:=False;
FMain.ImgBtn2.Visible:=False;
//FileInfo:=TStringList.Create;
if Files.count > 0 then begin
FMain.Gauge2.MaxValue:=Files.Count;
for i:=0 to Files.Count-1 do begin
FileInfo:=Tokenize(Files[i],'|');
LocalFile := MyDir + FileInfo[3];
RemoteFile := USettings[1] + ReplaceStr(FileInfo[3],'\','/');
RemoteFile := RemoteFile + '.zip';
FMain.Gauge1.MaxValue:=StrToInt(FileInfo[1]);
If(FileExists(LocalFile)) then
CrcLocal:=GetFileCrc(LocalFile)
else CrcLocal:=0;
if(IntToStr(CrcLocal)<>FileInfo[2]) then
begin
If(DirectoryExists(ExtractFilePath(MyDir+FileInfo[3]))=False) then
ForceDirectories(ExtractFilePath(MyDir+FileInfo[3]));
FMain.Label3.Caption:='Downloading '+ExtractFileName(LocalFile)+' ...';
HttpGetFile(RemoteFile,MyDir+FileInfo[3]+'.utmp');
If(FileExists(MyDir+FileInfo[3]+'.utmp')) then
begin
FMain.KAZip1.Open(MyDir+FileInfo[3]+'.utmp');
FMain.KAZip1.ExtractToFile(0,LocalFile);
FMain.KAZip1.Close;
DeleteFile(MyDir+FileInfo[3]+'.utmp');
end;
end;
FMain.Gauge2.Progress:= i;
FileInfo.Clear;
end;
end;
FMain.Gauge2.Progress:=0;
FMain.Gauge1.Progress:=0;
FMain.ImgBtn1.Visible:=True;
FMain.ImgBtn2.Visible:=True;
FMain.Repaint;
if GetCritical = 0 then
FMain.Label3.Caption:= 'Tous les fichiers sont mis à jour.'
else
begin
GetCritical:=0;
FMain.Label3.Caption:= '';
end;
Files.Clear;
end;
procedure LoadSettings;
//var
// Settings: TInifile;
begin
USettings := TStringlist.Create;
USettings.Add('');
USettings.Add('');
end;
procedure RunApp(Path: string);
var
p1, p2: array[0..100] of Char;
w1: cardinal;
begin
ChDir(ExtractFilePath(Path));
StrPcopy(p1, ExtractFilePath(Path));
if GetModuleHandle(p1) = 0 then
begin
StrPcopy(p2, Path);
w1 := WinExec(p2, SW_Restore);
end;
end;
procedure SelfUpdate;
var
LSTFile:TInifile;
LocalFile,RemoteFile:String;
FileInfo:TStringlist;
CrcLocal:cardinal;
begin
LSTFile := TIniFile.Create(MyDir+'updates.lst');
USettings.Add(LSTFile.ReadString('self','IAM',''));
if(USettings[2]<>'') then begin
FMain.ImgBtn1.Visible:=False;
FMain.ImgBtn2.Visible:=False;
FileInfo:=Tokenize(USettings[2],'|');
LocalFile:=GetCurrentDir+'\'+FileInfo[2];
RemoteFile:=USettings[1]+ReplaceStr(FileInfo[2],'\','/');
RemoteFile:=RemoteFile+'.zip';
FMain.Gauge1.MaxValue:=StrToInt(FileInfo[0]);
CrcLocal:=GetFileCrc(LocalFile);
if(IntToStr(CrcLocal)<>FileInfo[1]) then begin
HttpGetFile(RemoteFile,MyDir+FileInfo[2]+'.utmp');
FMain.KAZip1.Open(MyDir+FileInfo[2]+'.utmp');
FMain.KAZip1.ExtractToFile(0,LocalFile+'.New');
FMain.KAZip1.Close;
//Rajouter le dl de taskkill
GenSelfUpdate(FileInfo[2]);
UpdateSelf:=2;
DeleteFile(MyDir+FileInfo[2]+'.utmp');
end;
end;
LSTFile.Free;
if(UpdateSelf=2) then begin
UpdateSelf:=0;
ShowMessage('Nouvel updater! Redémarrage en cours...');
RunApp(MyDir+'Update.bat');
//ShellExecute(Handle,nil,PChar(MyDir+'Update.bat'),nil, nil, SW_SHOWNORMAL);
//Application.Terminate;
end
else begin
FMain.ImgBtn1.Visible:=True;
FMain.ImgBtn2.Visible:=True;
end;
end;
procedure TFMain.FormCreate(Sender: TObject);
var
regn, tmpRegn, x, y: integer;
nullClr: TColor;
IObj: IUnknown;
SLink: IShellLink;
PFile: IPersistFile;
desk, ilname : string;
lnkpath : WideString;
Settings: TInifile;
begin
Files:=TStringList.Create;
MyDir := GetCurrentDir+'\';
//if(FileExists(MyDir+'updater.ini')=False) then
// begin
// ShowMessage('ERREUR: Updater.ini Introuvable !');
// Application.Terminate;
// end;
GetCritical :=1;
UpdateSelf :=1;
LoadSettings;
Settings := TInifile.Create(MyDir+'updater.ini');
ilname:=Settings.ReadString('main','LinkName','');
if(ilname<>'') then begin
SetLength(desk, MAX_PATH+1);
SHGetSpecialFolderPath(0, PAnsiChar(desk),CSIDL_DESKTOPDIRECTORY,False);
lnkpath:= PChar(desk)+'\'+ilname+'.lnk';
IObj := CreateComObject(CLSID_ShellLink);
SLink := IObj as IShellLink;
PFile := IObj as IPersistFile;
with SLink do
begin
SetDescription(PChar('Lancer le jeu.'));
SetPath(PChar(Application.ExeName));
SetWorkingDirectory(PAnsiChar(MyDir));
end;
PFile.Save(PWChar(WideString(lnkpath)), FALSE);
Settings.DeleteKey('main','LinkName');
end;
Settings.Free;
FMain.brush.bitmap:=image1.picture.bitmap;
nullClr := image1.picture.Bitmap.Canvas.Pixels[0, 0];
regn := CreateRectRgn(0, 0, image1.picture.Graphic.Width,
image1.picture.Graphic.Height);
for x := 1 to image1.picture.Graphic.Width do
for y := 1 to image1.picture.Graphic.Height do
if image1.picture.Bitmap.Canvas.Pixels[x - 1, y - 1] = nullClr then
begin
tmpRegn := CreateRectRgn(x - 1, y - 1, x, y);
CombineRgn(regn, regn, tmpRegn, RGN_DIFF);
DeleteObject(tmpRegn);
end;
SetWindowRgn(FMain.handle, regn, True);
WebBrowser1.Navigate(USettings[0]);
end;
procedure TFMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Draging := True;
x0 := x;
y0 := y;
end;
procedure TFMain.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Draging := false;
end;
procedure TFMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Draging = True then
begin
FMain.Left := FMain.Left + X - X0;
FMain.top := FMain.top + Y - Y0;
end;
end;
procedure TFMain.ImgBtn4Click(Sender: TObject);
begin
close();
end;
procedure TFMain.ImgBtn3Click(Sender: TObject);
begin
close();
end;
procedure TFMain.ImgBtn2Click(Sender: TObject);
var
LSTFile : Tinifile;
begin
GetCritical :=0;
ProcessFileList(2);
Label3.Caption:='';
if (FileExists(MyDir+'updates.lst')) then begin
LSTFile := Tinifile.Create(MyDir+'updates.lst');
//if (LSTFile.ReadString('misc','ModifyHost','0')<>'0') then ModHosts;
h1 := beginthread(nil, 1024, @GetUpdate, nil, 0, th1);
LSTFile.Free;
end;
end;
//Procedure Start...
procedure TFMain.ImgBtn1Click(Sender: TObject);
begin
RunApp(MyDir+'system\l2.exe');
Close();
end;
procedure TFMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
terminatethread(h1, 0);
USettings.Free;
Files.Destroy;
if (FileExists(MyDir+'updates.lst')) then
DeleteFile(MyDir+'updates.lst');
end;
//settings
procedure TFMain.ImgBtn5Click(Sender: TObject);
begin
FMain.Enabled:=False;
Frm_Settings.Show;
end;
procedure TFMain.Img_Btn_ModhostClick(Sender: TObject);
begin
FMain.Enabled:=False;
Frm_ModHost.Show;
end;
procedure TFMain.WebBrowser1NavigateComplete2(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
begin
FMain.Panel1.Visible:=True;
end;
procedure TFMain.FormShow(Sender: TObject);
begin
if(HTTPGetFile(USettings[1]+'updates.lst',MyDir+'updates.lst')) then begin
ProcessFileList(1);
label3.Caption:='';
end
else
label3.Caption:='ERREUR: LST introuvable...';
if(FileExists(MyDir+'updates.lst')) then begin
if (UpdateSelf = 1) then SelfUpdate;
FMain.ImgBtn1.Visible:=True;
FMain.ImgBtn2.Visible:=True;
if (GetCritical = 1) then
h1 := beginthread(nil, 1024, @GetUpdate, nil, 0, th1);
end;
end;
end.
01-03-2011
Temas Similares
Modo Hilado