PASCAL三大病毒软件

PASCAL三大病毒软件

1.program bingdu; var a:integer; begin a:=1; while a=1 do write('!'); end.

Program menudemo; {$APPTYPE GUI} {$MODE DELPHI}

Uses Strings,Windows,CommDlg,CommCtrl; Const AppName = 'Welcome \Var AMessage: Msg;

hWindow,hStatus,Hedit: HWnd; WindowClass: WndClass; Menu: hMenu; Const

EditMenus: Array[200..203] Of pchar = ('Cut','Copy','Paste','Select All'); Type

TFileName = Array[0..Max_Path] Of Char;

Function SelectFile(Var FName:TFileName; Open:Boolean): Boolean; Const

Filter: PChar = 'Text files (*.txt)'#0'*.txt'#0'All files (*.*)'#0'*.*'#0; Ext: PChar = 'txt'; Var

NameRec: OpenFileName; Begin

FillChar(NameRec,SizeOf(NameRec),0); FName[0] := #0; With NameRec Do Begin

LStructSize := SizeOf(NameRec); HWndOwner := HWindow; LpStrFilter := Filter; LpStrFile := @FName; NMaxFile := Max_Path;

Flags := OFN_Explorer Or OFN_HideReadOnly; If Open Then Begin

Flags := Flags Or OFN_FileMustExist; End;

LpStrDefExt := Ext; End; If Open Then

SelectFile := GetOpenFileName(@NameRec) Else

SelectFile := GetSaveFileName(@NameRec); End;

Procedure SaveText; Var Len: Longint; P: PChar; F: File;

FName: TFileName; Begin

If SelectFile(FName,False) Then Begin

Assign(F,@FName); Rewrite(F,1);

Len := GetWindowTextLength(HEdit); GetMem(P,Len+1); P[Len] := #0; If Len>0 Then Begin

GetWindowText(HEdit,P,Len+1); BlockWrite(F,P^,Len); End; Close(F);

FreeMem(P,Len+1); End; End;

Procedure AskSave; Begin

If MessageBox(HWindow,'是否保存文件?','Edited',MB_IconQuestion Or MB_YesNo)=IdYes Then Begin SaveText; End; End;

Procedure LoadText; Var

FName: TFileName; F: File; Len: LongInt; P: PChar; Begin

AskSave;

If SelectFile(FName,True) Then Begin

Assign(F,@FName); Reset(F,1); Len := FileSize(F); GetMem(P,Len+1); P[Len] := #0;

If Len>0 Then BlockRead(F,P^,Len); Close(F);

SetWindowText(HEdit,P); FreeMem(P,Len+1); End; End;

Procedure NewText; Const

Empty: PChar = ''; Begin AskSave;

SendMessage(HEdit,WM_SetText,1,LongInt(Empty)); End;

Function WindowProc (Window:HWnd;AMessage : UINT; WParam : WParam; LParam:LParam): LResult; stdcall; export;

Var ps: paintstruct; r: rect; StatH: Word; nrmenu : longint; Begin

WindowProc := 0; Case AMessage Of wm_Paint: Begin

BeginPaint(Window,@ps); GetClientRect(Window,@r); EndPaint(Window,ps); Exit; End; wm_Close: Begin AskSave; End; wm_Destroy:

Begin

PostQuitMessage (0); Exit; End; wm_Size: Begin

if HStatus<>0 then begin

GetClientRect(HStatus,@R); StatH := R.Bottom-R.Top; GetClientRect(Window,@R);

MoveWindow (hStatus,r.left,r.bottom-StatH,r.right,r.bottom,true); if HEdit<>0 then

MoveWindow (HEdit,0,0,r.right-r.left,r.bottom-r.top-StatH,true); end; End; wm_Command: Begin

NrMenu := WParam And $FFFF; Case NrMenu Of 101 : NewText; 102 : LoadText; 103 : SaveText;

104 : PostMessage(Window,WM_Close,0,0);

201..203: MessageBox(Window,EditMenus[NrMenu],

'Edit operation not implemented',MB_OK Or MB_IconInformation); End; End; End;

WindowProc := DefWindowProc(Window,AMessage,WParam,LParam); End;

Function WinRegister: Boolean; Begin

With WindowClass Do Begin

Style := cs_hRedraw Or cs_vRedraw; lpfnWndProc := WndProc(@WindowProc); cbClsExtra := 0; cbWndExtra := 0;

hInstance := system.MainInstance; hIcon := LoadIcon (0,idi_Application); hCursor := LoadCursor (0,idc_Arrow);