demounit.dfm

PIC 单片机 PAS SOURCE CODE SAMPLES

          '  Params^.hReadPipe := hNIReadPipe;'
          ''
          ''
          '  ReaderHandle := CreateThread( nil,'
          '                                0,'
          '                                @ThreadRead,'
          '                                Params,'
          '                                0,'
          '                                ReaderId);'
          '  if ReaderHandle = 0 then'
          '   begin'
          '     ResponseInfo.ContentText := FTimeOutMsg;'
          
            '     ResponseInfo.ContentLength := Length(ResponseInfo.ContentTe' +
            'xt);'
          '     ResponseInfo.ResponseNo := 500;'
          '     Result :=  ResponseInfo.ContentLength;'
          '     Exit;'
          '   end;'
          ''
          ''
          '  if CreateProcess(nil,'
          '                   PChar(LocalDoc),'
          '                   nil,'
          '                   nil,'
          '                   True,'
          '                   0,'
          '                   PChar(cEnv),'
          '                   nil,'
          '                   StartInfo,'
          '                   ProcInfo)'
          '  then'
          '    begin'
          '      CloseHandle(ProcInfo.hThread);'
          '      CloseHandle(hWritePipe);'
          '    end'
          '  else'
          '   begin'
          '     ResponseInfo.ContentText := FTimeOutMsg;'
          
            '     ResponseInfo.ContentLength := Length(ResponseInfo.ContentTe' +
            'xt);'
          '     ResponseInfo.ResponseNo := 500;'
          '     Result :=  ResponseInfo.ContentLength;'
          '     Exit;'
          '   end;'
          ''
          ''
          
            '  if WaitForSingleObject(ReaderHandle, FTimeOUT) = WAIT_TIMEOUT ' +
            'then'
          ''
          '     begin'
          '        TerminateThread(ReaderHandle,0);'
          '        TerminateProcess(ProcInfo.hProcess, 1);'
          '        ResponseInfo.ContentText := FTimeOutMsg;'
          
            '        ResponseInfo.ContentLength := Length(ResponseInfo.Conten' +
            'tText);'
          '        ResponseInfo.ResponseNo := 500;'
          '        Result :=  ResponseInfo.ContentLength;'
          '        Exit;'
          '     end;'
          ''
          ''
          '   ParsLine := Params^.s;'
          '   I := Pos(#13#10#13#10,Params^.s);'
          '   if i > 0 then'
          '    begin'
          '      ParsLine := Copy(ParsLine,1,I+3);'
          
            '      ParsLine := StringReplace(ParsLine,'#39': '#39','#39'='#39',[rfReplaceAll]' +
            ');'
          '      ParsList := TStringList.Create;'
          '      ParsList.Text := ParsLine;'
          
            '      ResponseInfo.ContentType   := ParsList.Values['#39'content-typ' +
            'e'#39'];'
          
            '      ResponseInfo.ResponseNo    := StrToIntDef(Copy(ParsList.Va' +
            'lues['#39'status'#39'],1,3),200);'
          '      ResponseInfo.WriteHeader;'
          
            '      ResponseInfo.ContentText   := Copy(Params^.s,I+4, Length(P' +
            'arams^.s));'
          '      ParsList.Free;'
          '     end'
          '       else'
          '         begin'
          '           ResponseInfo.ContentType := '#39'text/html'#39';'
          '         end;'
          ''
          '   Result :=  ResponseInfo.ContentLength;'
          ''
          '  finally'
          '    if ReaderHandle > 0 then'
          '       CloseHandle(ReaderHandle);'
          '    if ProcInfo.hProcess > 0 then'
          '       CloseHandle(ProcInfo.hProcess);'
          '    if hReadPipe > 0 then'
          '       CloseHandle(hNIReadPipe);'
          '    if Assigned(Params) then'
          '       Dispose(Params);'
          '  end;'
          ''
          'end;'
          ''
          ''
          'procedure TidCGIRunner.Notification(AComponent: TComponent;'
          '  Operation: TOperation);'
          'begin'
          '  inherited;'
          '  if (Operation = opRemove) and (AComponent = FServer) then'
          '    FServer := nil;'
          'end;'
          ''
          'procedure TidCGIRunner.SetServer(const AValue: TIdHTTPServer);'
          'begin'
          '  if FServer <> AValue then'
          '  begin'
          '    if Avalue <> nil then AValue.FreeNotification(Self);'
          '    FServer := AValue;'
          '  end;'
          'end;'
          ''
          ''
          'procedure Register;'
          'begin'
          '  RegisterComponents('#39'Indy Misc'#39', [TidCGIRunner]);'
          'end;'
          ''
          'end.')
        ParentFont = False
        PlainText = True
        ScrollBars = ssBoth
        TabOrder = 0
        WordWrap = False
      end
    end
    object tsHTML: TTabSheet
      Caption = 'HTML'
      ImageIndex = 1
      object edHTML: TRichEdit
        Left = 0
        Top = 0
        Width = 735
        Height = 570
        Align = alClient
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clWindowText
        Font.Height = -13
        Font.Name = 'MS Sans Serif'
        Font.Style = []
        Lines.Strings = (
          
            '<html><head><title>Indy demo server with CGI support</title></he' +
            'ad>'
          '<body>'
          ''
          
            '<h1 align="center">TidISAPIRunner component for Internet Direct ' +
            '(Indy) Web Server&nbsp;</h1>'
          
            '<p>Author:&nbsp; <a href="mailto:[e-mail]">S' +
            'erhiy Perevoznyk</a>&nbsp;<br>'
          
            'Use, modification and distribution is allowed without limitation' +
            ', warranty, or liability of any'
          'kind.<br>'
          '</p>'
          
            '<p><b>TidISAPIRunner</b> component allows to execute ISAPI scrip' +
            'ts using <i>Indy</i>'
          'TidHTTPServer.<br>'
          
            '<a href="http://www.nevrona.com/indy">Internet Direct (Indy) lib' +
            'rary</a> is'
          'required.</p>'
          '<p>Run the <a href="isapi_test.dll">test ISAPI script<br>'
          
            '</a>Run the <a href="isapi_test.dll/test">test ISAPI script with' +
            ' parameters</a></p>'
          '<p>Links:<b><br>'
          
            'TidCGIRunner </b>component allows to execute CGI scripts using <' +
            'i>Indy</i>'
          'TidHTTPServer.<br>'
          
            '&nbsp;<a href="http://www.delphipages.com/result.cfm?ID=3077">do' +
            'wnload</a></p>'
          
            '<p><b>TidISAPIRunner</b> component allows to run ISAPI modules u' +
            'sing Indy'
          'TidHTTPServer.<br>'
          
            '<a href="http://www.delphipages.com/result.cfm?ID=3080">download' +
            '</a></p>'
          
            '<p><b>psvDialogs Library </b>contains components based on undocu' +
            'mented Windows'
          'functions<br>'
          'Components:<b><br>'
          'TpsvExitWindowsDialog<br>'
          'TpsvRunDialog<br>'
          'TpsvOrganizeFavoritesDialog<br>'
          'TpsvFormatDialog<br>'
          'TpsvComputerNameDialog<br>'
          'TpsvBrowseFolderDialog<br>'
          'TpsvControlPanelDialog<br>'
          'TpsvAppletDialog<br>'
          'TpsvChangeIconDialog<br>'
          'TpsvShellAboutDialog<br>'
          'TpsvOutOfMemoryDialog<br>'
          'TpsvObjectPropertiesDialog<br>'
          'TpsvOpenDialog<br>'
          'TpsvSaveDialog<br>'
          'TpsvNewLinkDialog<br>'
          'TpsvAddHardwareDialog<br>'
          'TpsvOpenWidthDialog<br>'
          'TpsvDiskFullDialog<br>'
          
            '</b><a href="http://www.delphipages.com/result.cfm?ID=2695">down' +
            'load</a></p>'
          '<p><a href="http://www.delphipages.com/result.cfm?ID=2695"><br>'
          
            '</a><b>psvLabels Library</b> contains set of original and enhanc' +
            'ed label'
          'components. <br>'
          'Includes components:<br>'
          
            '<b>TpsvBasicLabel</b> Provides a mouse enter and mouse leave eve' +
            'nts and has a'
          'FocusColor property<br>'
          
            '<b>TpsvWebLabel</b> &nbsp;This component emulates hypertext in a' +
            ' html form<br>'
          '<b>TpsvTransLabel</b> Simulates translucent color glass<br>'
          
            '<b>TpsvRTFLabel</b> TpsvRTFLabel component is a marquee transpar' +
            'ent label that'
          
            'has the full rich text capabilities. It can displays a vertical ' +
            'scrolling text'
          'with a different speed.<br>'
          '<b>TpsvLCDLabel</b> Simulates LCD display<br>'
          '<b>TpsvBorderLabel</b> Label with a 3D border<br>'
          
            '<b>TpsvLinkedLabel</b> Label that can be linked to any control o' +
            'n the form and'
          
            'will follows this control when it moves keeping right position a' +
            'nd distance even'
          
            'in design time<a href="http://www.delphipages.com/result.cfm?ID=' +
            '2903"><br>'
          'download</a></p>'
          '<p>&nbsp;</p>'
          ''
          '</body>'
          '</html>')
        ParentFont = False
        PlainText = True
        ScrollBars = ssBoth
        TabOrder = 0
        WordWrap = False
      end
    end
    object tsSQL: TTabSheet
      Caption = 'SQL'
      ImageIndex = 2
      object edSQL: TRichEdit
        Left = 0
        Top = 0
        Width = 735
        Height = 570
        Align = alClient
        Font.Charset = DEFAULT_CHARSET
        Font.Color = clWindowText
        Font.Height = -13
        Font.Name = 'MS Sans Serif'
        Font.Style = []
        Lines.Strings = (
          'select * from customer')
        ParentFont = False
        ScrollBars = ssBoth
        TabOrder = 0
        WordWrap = False
      end
    end
    object tsPHP: TTabSheet
      Caption = 'PHP'
      ImageIndex = 3
      object edPHP: TRichEdit
        Left = 0
        Top = 0
        Width = 735
        Height = 570
        Align = alClient
        Font.Charset = RUSSIAN_CHARSET
        Font.Color = clWindowText
        Font.Height = -13
        Font.Name = 'Courier New'
        Font.Style = []
        Lines.Strings = (
          '<?php'
          '//'
          
            '// +------------------------------------------------------------' +
            '----------+'
          
            '// | PHP Version 4                                              ' +
            '          |'
          
            '// +------------------------------------------------------------' +
            '----------+'
          
            '// | Copyright (c) 1997-2002 The PHP Group                      ' +
            '          |'
          
            '// +------------------------------------------------------------' +
            '----------+'
          
            '// | This source file is subject to version 2.02 of the PHP lice' +
            'nse,      |'