main.pas

windows 下的GTUB 系统引导程序

   i:=pos('/',v);
   if i=0 then exit;
   f2:=clr2int(copy(v,1,i-1));
   b2:=clr2int(copy(v,i+1,length(v)-i));
   if (f2=-1) or (b2=-1) then exit;
  end;
 b1:=b1 and 7;
 b2:=b2 and 7;
 if (f1=f2) and (b1=b2) then exit;
 fg1:=f1;
 bg1:=b1;
 fg2:=f2;
 bg2:=b2;
 SetPanelColor(Panel1,fg1,bg1);
 SetPanelColor(Panel2,fg2,bg2);
end;

begin
 clrcfs();
 sl:=TStringList.Create;
 sl.Text:=s;
 ListBox1.Items.BeginUpdate;
 p:=nil;
 for i:=0 to sl.Count-1 do
  begin
   v:=trim(sl.Strings[i]);
   c:=lowercase(popstr(v,' '));
   if c='' then continue;
   if c='title' then
    begin
     new(p);
     p.title:=v;
     p.value:='';
     ListBox1.Items.AddObject('',TObject(p));
    end else
   if p<>nil then p.value:=p.value+sl.Strings[i]+#13#10 else
    begin
     if c='timeout' then Edit1.Text:=v else
     if c='default' then df:=StrToIntDef(v,-1) else
     if c='fontfile' then begin CheckBox1.Checked:=true; if G2LName(v,'')='fonts' then fp:='' else fp:=v; end else
     if c='splashimage' then ComboBox2.Text:=G2LName(v,'.xpm.gz') else
     if c='foreground' then begin fg3:=StrToIntDef('$'+v,clWhite); SetPanelColor1(Panel3,fg3,bg3); end else
     if c='background' then begin bg3:=StrToIntDef('$'+v,clBlack); SetPanelColor1(Panel3,fg3,bg3); end else
     if c='color' then getclr else
     if c='password' then
      begin
       CheckBox2.Checked:=false;
       c:=popstr(v,' ');
       if c='--md5' then c:=popstr(v,' ') else CheckBox2.Checked:=true;
       pw:=c;
       if CheckBox2.Checked then Edit3.Text:=pw else Edit3.Text:='';
       Edit4.Text:=popstr(v,' ');
      end else ex:=ex+sl.Strings[i]+#13#10;
    end;
  end;
 ListBox1.Items.EndUpdate;
 sl.Free;
end;

function TMainForm.setcfs:string;
var i:integer; p:pitem;
begin
 result:='';
 if df<>-1 then result:=result+'default '+IntToStr(df)+#13#10;
 if Edit1.Text<>'' then result:=result+'timeout '+Edit1.text+#13#10;
 if CheckBox1.Checked then if fp<>'' then result:=result+'fontfile '+fp+#13#10 else
  result:=result+'fontfile '+L2GName('fonts','')+#13#10;
 if ComboBox2.Text<>'' then result:=result+'splashimage '+L2GName(ComboBox2.Text,'.xpm.gz')+#13#10;
 if (Edit3.Text<>'') or not CheckBox2.Checked and (pw<>'') then
  begin
   result:=result+'password ';
   if CheckBox2.Checked then result:=result+Edit3.Text else
   if Edit3.Text='' then result:=result+'--md5 '+pw else
    result:=result+'--md5 '+md5_mkpwd(Edit3.Text);
   if Edit4.Text<>'' then result:=result+' '+Edit4.Text;
   result:=result+#13#10;
  end;
 if (fg1<>7) or (bg1<>0) or (fg2<>0) or (bg2<>7) then
  result:=result+'color '+int2clr(fg1)+'/'+int2clr(bg1)+' '+int2clr(fg2)+'/'+int2clr(bg2)+#13#10;
 if (fg3<>clWhite) then result:=result+'foreground '+lowercase(IntToHex(fg3,6))+#13#10;
 if (bg3<>clBlack) then result:=result+'background '+lowercase(IntToHex(bg3,6))+#13#10;
 result:=result+ex;
 for i:=0 to ListBox1.Items.Count-1 do
  begin
   p:=pitem(ListBox1.Items.Objects[i]);
   result:=result+#13#10+'title '+p.title+#13#10+p.value;
  end;
end;

procedure TMainForm.clrlst;
var i:integer; p:pitem;
begin
 for i:=0 to ListBox1.ItemIndex-1 do
  begin
   p:=pitem(ListBox1.Items.Objects[i]);
   p.title:='';
   p.value:='';
   dispose(p);
  end;
 ListBox1.Clear;
 Edit2.Text:='';
 ListBox2.Clear;
end;

procedure TMainForm.ListBox1Click(Sender: TObject);
var itm:pitem;
begin
 if ListBox1.ItemIndex=-1 then ShowErr('No item is selected') else
  begin
   itm:=pitem(ListBox1.Items.Objects[ListBox1.ItemIndex]);
   Edit2.Text:=itm.title;
   ListBox2.Items.Text:=itm.value;
  end;
end;

procedure TMainForm.ComboBox1Change(Sender: TObject);
begin
 if ComboBox1.Text<>'' then getcfg(ap+'prof\'+ComboBox1.Text+'.LST');
end;

procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
 if ComboBox1.Text='' then SpeedButton2Click(nil) else SaveString(ap+'prof\'+ComboBox1.Text+'.LST',setcfs);
end;

procedure TMainForm.SpeedButton2Click(Sender: TObject);
var s:string; i:integer;
begin
 SaveDialog1.InitialDir:=ap+'prof';
 if SaveDialog1.Execute then
  begin
   SaveString(SaveDialog1.FileName,setcfs);
   if (Uppercase(ap+'prof\')=Uppercase(ExtractFilePath(SaveDialog1.FileName))) and (Uppercase(ExtractFileExt(SaveDialog1.FileName))='.LST') then
    begin
     s:=ExtractFileName(SaveDialog1.FileName);
     s:=copy(s,1,length(s)-4);
     i:=ComboBox1.Items.IndexOf(s);
     if i=-1 then i:=ComboBox1.Items.Add(s);
     ComboBox1.ItemIndex:=i;
    end;
  end;
 SaveDialog1.InitialDir:=lp;
 SaveDialog1.FileName:='';
end;

procedure TMainForm.SpeedButton3Click(Sender: TObject);
begin
 if ComboBox1.ItemIndex=-1 then
  begin
   ShowErr('No profile to delete');
   exit;
  end;
 if Confirm('Do you really want to delete the profile') then
  begin
   DeleteFile(ap+'prof\'+ComboBox1.Text+'.LST');
   ComboBox1.Items.Delete(ComboBox1.ItemIndex);
  end;
end;

procedure TMainForm.Open1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then
  begin
   setcfn(OpenDialog1.FileName);
   getcfg(fn);
  end;
end;

procedure TMainForm.Save1Click(Sender: TObject);
begin
 if fn='' then SaveAs1Click(nil) else setcfg(fn);
end;

procedure TMainForm.SaveAs1Click(Sender: TObject);
begin
 if SaveDialog1.Execute then
  begin
   setcfn(SaveDialog1.FileName);
   setcfg(fn);
  end;
end;

procedure TMainForm.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var s:string;
begin
 ListBox1.Canvas.FillRect(Rect);
 s:=pitem(ListBox1.Items.Objects[index])^.title;
 if index=df then s:='<'+s+'>';
 DrawText(ListBox1.Canvas.Handle,Pchar(s),length(s),Rect,dt_Left or dt_VCenter);
end;

procedure TMainForm.Panel3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 if (Button<>mbLeft) and (Button<>mbRight) then exit;
 if Button=mbLeft then ColorDialog1.Color:=fg3 else ColorDialog1.Color:=bg3;
 if ColorDialog1.Execute then
  begin
   if Button=mbLeft then fg3:=ColorDialog1.Color else bg3:=ColorDialog1.Color;
   SetPanelColor1(Panel3,fg3,bg3);
  end;
end;

procedure TMainForm.InstallGrub1Click(Sender: TObject);
var ID:TInstDlg;
begin
 ID:=TInstDlg.Create(self);
 ID.ShowModal;
 ID.release;
end;

procedure TMainForm.BootDirectory1Click(Sender: TObject);
var BD:TBaseDlg;
begin
 BD:=TBaseDlg.Create(self);
 if BD.ShowModal=mrOK then setcfn(lp+ExtractFileName(fn));
 BD.release;
end;

procedure TMainForm.PartitionList1Click(Sender: TObject);
var PD:TPartDlg;
begin
 PD:=TPartDlg.Create(self);
 PD.ShowModal;
 PD.release;
end;

procedure TMainForm.GrubFiles1Click(Sender: TObject);
var GD:TGrubDlg;
begin
 GD:=TGrubDlg.Create(self);
 GD.ShowModal;
 GD.Release;
end;

procedure TMainForm.SpeedButton6Click(Sender: TObject);
begin
 Edit3.Text:='';
 Edit4.Text:='';
 pw:=''; 
end;

procedure TMainForm.SpeedButton5Click(Sender: TObject);
var s:string;
begin
 s:=ap+'logo\'+ComboBox2.Text+'.jpg';
 if (ComboBox2.Text<>'') and FileExists(s) then
  ShellExec(s,'',SEF_SAPP);
end;

procedure TMainForm.ListBox1Key(Sender: TObject);
var
 key:Word; shift:TShiftState;
 i:integer; p:pitem; s:string;
begin
 ShortCutToKey(TMenuItem(sender).ShortCut,key,shift);
 if (Key=VK_INSERT) or (Key=ord('C')) then
  begin
   i:=ListBox1.ItemIndex+1;
   if i=0 then i:=ListBox1.Items.Count;
   if (Key=VK_INSERT) then
    begin
     Edit2.Text:='New Item';
     ListBox2.Clear;
    end;
   new(p);
   p.title:=Edit2.Text;
   p.value:=ListBox2.Items.Text;
   ListBox1.Items.InsertObject(i,'',TObject(p));
   ListBox1.ItemIndex:=i;
  end else
 if (Key=VK_DELETE) then
  begin
   if ListBox1.ItemIndex=-1 then exit;
   p:=pitem(ListBox1.Items.Objects[ListBox1.ItemIndex]);
   p.title:='';
   p.value:='';
   dispose(p);
   ListBox1.Items.Delete(ListBox1.ItemIndex);
  end else
 if Key=VK_SPACE then
  begin
   if ListBox1.ItemIndex=-1 then exit;
   if df=ListBox1.ItemIndex then df:=-1 else df:=ListBox1.ItemIndex;
   ListBox1.Invalidate;
  end else
 if (Key=ord('E')) then
  begin
   s:=setcfs;
   if EditString(s) then getcfs(s);
  end else
 if (Key=ord('U')) or (Key=ord('D')) or (Key=ord('T')) or (Key=ord('B')) then
  begin
   if (ListBox1.ItemIndex=-1) or (ListBox1.ItemIndex=0) and ((Key=ord('U')) or (Key=ord('T')))
       or (ListBox1.ItemIndex=ListBox1.Items.Count-1) and ((Key=ord('D')) or (Key=ord('B'))) then exit;
   i:=ListBox1.ItemIndex;
   p:=pitem(ListBox1.Items.Objects[i]);
   ListBox1.Items.Delete(i);
   if Key=ord('U') then dec(i) else
   if Key=ord('D') then inc(i) else
   if Key=ord('T') then i:=0 else
   if Key=ord('B') then i:=ListBox1.Items.Count;
   ListBox1.Items.InsertObject(i,'',TObject(p));
   ListBox1.ItemIndex:=i;
  end;
end;

procedure TMainForm.ListBox2Key(Sender: TObject);
var
 key:Word; shift:TShiftState;
 s:string; var p:pitem; i:integer;
begin
 ShortCutToKey(TMenuItem(sender).ShortCut,key,shift);
 if Key=VK_DELETE then
  begin
   if ListBox2.ItemIndex<>-1 then
    begin
     if ListBox2.ItemIndex=ListBox2.Items.Count-1 then i:=ListBox2.ItemIndex-1 else i:=ListBox2.ItemIndex;
     ListBox2.Items.Delete(ListBox2.ItemIndex);
     ListBox2.ItemIndex:=i;
    end;
  end;
 if Key=ord('E') then
  begin
   s:=ListBox2.Items.Text;
   if EditString(s) then
    begin
     ListBox2.ItemIndex:=-1;
     ListBox2.Items.Text:=s;
    end;
  end else
 if Key=ord('S') then
  begin
   if ListBox1.ItemIndex=-1 then ShowErr('No item is selected') else
   if Edit2.Text='' then ShowErr('The title can''t be blank') else
    begin
     p:=pitem(ListBox1.Items.Objects[ListBox1.ItemIndex]);
     p.title:=Edit2.Text;
     p.value:=ListBox2.Items.Text;
     ListBox1.Invalidate;
    end;
  end else
 if Key=ord('R') then
  begin
   if ListBox1.ItemIndex=-1 then
    begin
     Edit2.Text:='';
     ListBox2.Clear;
    end else
    begin
     p:=pitem(ListBox1.Items.Objects[ListBox1.ItemIndex]);
     Edit2.Text:=p.title;
     ListBox2.Items.Text:=p.value;
    end;
  end;
end;

const
 BUF_SIZE       = 10240;

var
 buf:pchar;
 len,ps0,ps1:integer;

function FndStr(hd:dword;ss:string):integer;
var ps2:integer;
begin
 result:=-1;
 ps2:=1;
 repeat
  if ps1=0 then
   begin
    if not ReadFile(hd,buf^,BUF_SIZE,dword(len),nil) or (len=0) then exit;
   end;
  while (ps1<len) do
   begin
    if buf[ps1]=ss[ps2] then
     begin
      inc(ps2);
      if ps2>length(ss) then
       begin
        inc(ps1);
        result:=ps0+ps1;
        exit;
       end;
     end else ps2:=1;
    inc(ps1);
   end;
  inc(ps0,len);
  ps1:=0;
 until false;
end;

procedure TMainForm.ReadPresetMenu1Click(Sender: TObject);
var ok:boolean; p1,p2,nr:integer; hd:dword; s,k,v:string;
begin
 if not OpenDialog3.Execute then exit;
 hd:=CreateFile(pchar(OpenDialog3.FileName),GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
 if hd=INVALID_HANDLE_VALUE then
  begin
   ShowErr('Can''t open file');
   exit;
  end;
 ok:=false;
 try
  getmem(buf,BUF_SIZE);
  len:=BUF_SIZE;
  ps0:=0;
  ps1:=0;
  p1:=FndStr(hd,'# PRESET START'#10);
  if p1<>-1 then
   begin
    p2:=FndStr(hd,'# PRESET END');
    if (p2<>-1) and (p2-p1>12) then
     begin
      freemem(buf);
      getmem(buf,p2-p1-11);
      buf[p2-p1-12]:=#0;
      if (SetFilePointer(hd,p1,nil,FILE_BEGIN)<>$FFFFFFFF) and ReadFile(hd,buf^,p2-p1-12,dword(nr),nil) and (nr=p2-p1-12) then
       begin
        s:='';
        v:=string(buf);
        repeat
         k:=popstr(v,#10);
         if k<>'' then s:=s+k+#13#10;
        until v='';
        getcfs(s);
        ok:=true;
       end;
     end;
   end;
  freemem(buf);
 except
 end;
 CloseHandle(hd);
 if not ok then ShowErr('Preset menu signature not found');
end;

procedure TMainForm.Save2Click(Sender: TObject);
var s,k,v:string; ok:boolean; i,p1,p2:integer; hd:dword;
begin
 if not SaveDialog2.Execute then exit;
 hd:=CreateFile(pchar(SaveDialog2.FileName),GENERIC_READ or GENERIC_WRITE,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
 if hd=INVALID_HANDLE_VALUE then
  begin
   ShowErr('Can''t open file');
   exit;
  end;
 ok:=false;
 try
  getmem(buf,BUF_SIZE);
  len:=BUF_SIZE;
  ps0:=0;
  ps1:=0;
  p1:=FndStr(hd,'# PRESET START'#10);
  if p1<>-1 then
   begin
    p2:=FndStr(hd,'# PRESET END');
    if (p2<>-1) then
     begin
      s:='';
      v:=setcfs;
      repeat
       k:=popstr(v,#13#10);
       if k<>'' then s:=s+k+#10;
      until v='';
      if s='' then ok:=true else
      if (length(s)>p2-p1-12) then begin ShowErr(IntToStr(length(s)-p2+p1+12)+' bytes overflown');ok:=true end else
       begin
        freemem(buf);
        getmem(buf,p2-p1-12);
        move(pchar(s)^,buf^,length(s));
        for i:=length(s) to p2-p1-13 do buf[i]:=#10;
        ok:=(SetFilePointer(hd,p1,nil,FILE_BEGIN)<>$FFFFFFFF) and WriteFile(hd,buf^,p2-p1-12,dword(i),nil) and (i=p2-p1-12);
       end;
     end;
   end;
  freemem(buf);
 except
 end;
 CloseHandle(hd);
 if not ok then ShowErr('Preset menu signature not found');
end;

end.