pub_program.pas

以前写的一个利用P2P 技术的一个通讯的例子。里面用到了 DBISAM 、INDY 控件。

         Dec(NestingLevel);
      end;

   begin
      NestingLevel := 0;
      Reader := TReader.Create(Input, 4096);
      SaveSeparator := DecimalSeparator;
      DecimalSeparator := '.';
      try
         Writer := TWriter.Create(Output, 4096);
         try
            Reader.ReadSignature;
            ConvertObject;
         finally
            Writer.Free;
         end;
      finally
         DecimalSeparator := SaveSeparator;
         Reader.Free;
      end;
   end;

begin
   result := '';
   if (v = nil) or (O = nil) then
      exit;
   VName := v.Name;

   BinStream := TMemoryStream.Create;
   try
      StrStream := TStringStream.Create(s);
      try
         BinStream.WriteComponent(o);
         BinStream.Seek(0, soFromBeginning);
         ObjectBinaryToText(BinStream, StrStream);
         StrStream.Seek(0, soFromBeginning);
         // Result := StrStream.DataString;
      finally
         freeandnil(StrStream);

      end;
   finally
      freeandnil(BinStream)
   end;
end;

function cryptstr(const s: string; stype: dword): string;
var
   i: integer;
   fkey: integer;
begin
   result := '';
   case stype of
      0: // setpass;
         begin
            randomize;
            fkey := random($FF);
            for i := 1 to length(s) do
               result := result + chr(ord(s[i]) xor i xor fkey);
            result := result + char(fkey);
         end;
      1: // getpass
         begin
            fkey := ord(s[length(s)]);
            for i := 1 to length(s) - 1 do
               result := result + chr(ord(s[i]) xor i xor fkey);
         end;
   end;
end;

procedure bold_sg(sg_jl: TAdvStringGrid);
begin
   with sg_jl do
      begin
         DefaultRowHeight := 22;
         rowheights[0] := 20;
         font.Style := [fsbold];
         font.Color := clnavy;
         selectioncolor := clinfobk;
         selectiontextcolor := clmaroon;
      end;
end;

function trim_wy(m_src: string; m_flag: smallint = 0): string;
var
   i, j: integer;
begin
   result := m_src;
   case m_flag of
      0: result := trim(m_src);
      1: //left
         begin
            j := 0;
            for i := 1 to length(m_src) do
               if ord(m_src[i]) > 31 then
                  begin
                     j := i;
                     break;
                  end;
            if j > 0 then
               result := copy(m_src, j, length(m_src));
         end;
      2: //right
         begin
            j := 0;
            for i := length(m_src) to 1 do
               if ord(m_src[i]) > 31 then
                  begin
                     j := i;
                     break;
                  end;
            if j > 0 then
               result := copy(m_src, 1, j);
         end;
   end;
end;

procedure refresh_pubdate;
begin
   {with f_reca_dm.qy_wangy do
      begin
         close;
         sql.Clear;
         sql.Add('select date from config');
         open;
         Gstr_Pubdate := datetostr(fieldbyname('date').asdatetime);
         close;
      end;}
end;

function comp_year(adate, ddate: string): boolean;
var
   year1, year2, month1, month2, day1, day2: word;
begin
   DecodeDate(strtodate(adate), Year1, Month1, Day1);
   DecodeDate(strtodate(ddate), Year2, Month2, Day2);
   result := year1 = year2;
end;

function beauty_str(m_src: string): string;
var
   i: integer;
   s: string;
   m_beng: boolean;
begin
   m_src := trim(m_src);
   s := '';
   result := m_src;
   for i := 1 to length(m_src) do //先去除多馀空格;
      if (m_src[i] <> ' ') or ((m_src[i] = ' ') and (m_src[i + 1] <> ' ')) then
         s := s + m_src[i];

   m_bEng := false;
   for i := 1 to length(s) do
      case s[i] of
         chr(8), chr(32)..chr(57), chr(65)..chr(90), chr(97)..chr(122):
            m_bEng := true;
         else
            begin
               m_bEng := false;
               exit;
            end;
      end;

   m_src := lowercase(s);
   s := '';
   for i := 1 to length(m_src) do //先去除多馀空格;
      if (i = 1) or ((m_src[i - 1] = ' ') and (m_src[i] <> ' ')) then
         s := s + chr(ord(m_src[i]) - 32)
      else
         s := s + m_src[i];
   result := s;
end;

function getlunar_day(m_date: TDatetime): string;
var
   i, j, k: word; //  k,
   span: integer;
   s: string;
begin
   {span := CalcDateDiff(m_date, strtodate('1901-01-01'));
   l_CalcLunarDate(i, j, k, span);
   s := FormatMonth(j) + FormatLunarDay(k); // FormatLunarYear(i) +
   result := 'date:' + s + '*';
   s := GetLunarHolDay(m_date);
   result := result + 'holiday:' + s + '*';
   s := GetConstellationName(m_date);
   result := result + 'west:' + s + '*';}
end;

procedure query_db(m_strsql: string; m_shint: string = '');
begin
   {with f_reca_dm.qy_wangy do
      begin
         close;
         sql.Clear;
         sql.Add(m_strsql);
         open;
         if RecordCount = 0 then
            begin
               MessageDlg(getstr(m_shint, nodata_msg), mtinformation, [mbok], 0);
               close;
               abort;
            end;
         close;
      end;}
end;

procedure common_deal(QuickRep1: TQuickRep; rpt_name: string = '');
var
   s: string;
   XLSFilt: TQRXLSFilter;
   RTFFilt: TQRRTFExportFilter;
   HTMFilt: TQRGHTMLDocumentFilter;
   PDFFilt: TQRPDFExportFilter;
   PDF_qrp: TQRPDFDocumentFilter;
   TXTFilt: TQRAsciiExportFilter; {}
   FSearchRec: TSearchRec;
begin
   {PDFFilt := TQRPDFDocumentFilter.Create('PDFExport uncomp.pdf');
   pdffilt.AddFontMap('WebDings:ZapfDingBats');
   pdffilt.TextOnTop := true;
   pdffilt.LeftMargin := 25;
   pdffilt.topMargin := -10;
   pdffilt.CompressionOn := false;
   pdffilt.Concatenating := true;
   pdffilt.SetTempPath('c:\temp');
   F_RPT_ZZKRMD.QuickRep1.ExportToFilter(PDFFilt);
   F_RPT_ZZKRMD.close;
   pdffilt.EndConcat;
   pdffilt.Free;
   }
   if gint_rptflag > 1 then
      begin
         s := '.\' + datetostr(strtodate(gstr_pubdate), 6) + '\'; // + datetostr(strtodate(gstr_pubdate), 6);
         //s := 'C:\Inetpub\wwwroot\web-hotel\Manage\Report\' + datetostr(strtodate(gstr_pubdate), 6); // + '\';
         //s := datetostr(strtodate(gstr_pubdate), 6);
         if FindFirst(s, faAnyFile, FSearchRec) <> 0 then
            createdirectory(pchar(s), nil);
         FindClose(FSearchRec);
         s := s + '\';
      end;
   //showmessage(QuickRep1.Parent.ClassName);
   try
      case gint_rptflag of
         0: QuickRep1.preview;
         1: QuickRep1.print;
         2: //html      {
            begin
               HTMFilt := TQRGHTMLDocumentFilter.Create(s + rpt_name + '.htm');
               //HTMFilt.Concat := true;
               //HTMFilt.ConcatCount := 2;
               //HTMFilt.PictureDir := 'webpics';
               HTMFilt.MultiPage := false;
               HTMFilt.PageLinks := true;
               //HTMFilt.FirstLastLinks := true;
               //HTMFilt.FinalPage := 10;
               HTMFilt.LinkFontName := 'Arial';
               QuickRep1.ExportToFilter(HTMFilt);
               HTMFilt.Free;
            end;
         3: //rtf
            begin
               RTFFilt := TQRRTFExportFilter.create(s + rpt_name + '.doc');
               QuickRep1.ExportToFilter(RTFFilt);
               RTFFilt.Free;
            end;
         4: //pdf
            begin
               PDFFilt := TQRPDFExportFilter.create(s + rpt_name + '.pdf');
               QuickRep1.ExportToFilter(PDFFilt);
               PDFFilt.Free;
            end;
         5: //pdf
            begin
               PDF_qrp := TQRPDFDocumentFilter.create(s + rpt_name + '_qrp.pdf');
               QuickRep1.ExportToFilter(PDF_qrp);
               PDF_qrp.Free;
            end;
         6: //excel
            begin
               XLSFilt := TQRXLSFilter.create(s + rpt_name + '.xls');
               QuickRep1.ExportToFilter(XLSFilt);
               XLSFilt.Free;
            end;
         7: //txt
            begin
               TXTFilt := TQRAsciiExportFilter.create(s + rpt_name + '.txt');
               QuickRep1.ExportToFilter(TXTFilt);
               TXTFilt.Free;
            end; //}
      end;
   except
      MessageDlg('prn_msg', mtconfirmation, [mbok], 0);
      //f_reca_dm.HOTELDB.Connected := false;
   end;
end;

procedure MakeRounded(Control: TWinControl);
var
   R: TRect;
   Rgn: HRGN;
begin
   with Control do
      begin
         R := ClientRect;
         rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 20, 20);
         Perform(EM_GETRECT, 0, lParam(@r));
         InflateRect(r, -5, -5);
         Perform(EM_SETRECTNP, 0, lParam(@r));
         SetWindowRgn(Handle, rgn, True);
         Invalidate;
      end;
end;

function input_date: string;
begin
   {gstr_rq := inputbox_wy(input_box, bbrq_input, Gstr_pubdate, '.', 3);
   if gstr_rq = '.' then
      abort;
   result := compare_date(Gstr_rq, Gstr_pubdate);
   if result = '1' then
      begin
         MessageDlg(date_msg1 + late_msg + Gstr_pubdate + '!', mtinformation, [mbok], 0);
         abort;
      end; }
end;