博客园_D10.天地弦-生活的点点滴滴是珍贵的

tomcat虚拟路径的几种配置方法

2012-02-11T07:09:00Z

tomcat配置虚拟路径的4种方法
在tomcat中，webapp文件夹默认为web应用的根目录。

1.在tomcat\conf\server.xml中找到 host标签，在host标签中增加新的元素<Context/>并设置 Context的元素，其中path元素所设置的值就是在浏览器中所要访问的虚拟路径的名称；docBase元素所对应的值就是web应用所在的具体目录，这里既可以的相对webapp的相对路径，也可是文件的绝对路径。

<Engine name="Catalina" defaultHost="localhost">
.......

<Host name="localhost" appBase="webapps"
       unpackWARs="true" autoDeploy="true"
       xmlValidation="false" xmlNamespaceAware="false">

       <Context docBase="SHARP" path="/test" reloadable="true" />

       
      </Host>

</Engine>

2.在tomcat\conf\Catalina\localhost文件夹中设置一个web应用名称一样的xml文件。在xml文件中内容有一个<Context/>标签。

<Context path="/test" reloadable="true" />

3.直接在webapp目录下建一个包含WEB-INF/web.xml的项目应用文件夹，在游览器访问页面时会自动将此项目文件的名件名作为虚拟目录的名称。

4.直接在webapp目录下发布一个打包好的WAR文件，tomcat会自动解压war文件，在游览器访问页面时会自动将此项目文件的名件名作为虚拟目录的名称。

本文链接

接口委托实现

2011-11-29T07:21:00Z

1   TFMDesign = class(TFMBase, IDataSetOperator)
2   public
3     //注意名称要不一样,重新定义保存方法
4     procedure IDataSetOperator.DoApplyUpdates = ApplyUpdates;
5
6     //重写保存方法
7     procedure ApplyUpdates; stdcall;
8
9     //接口用对象
10     property __Service: TDataSetOperator read F__Service write F__Service
11         implements IDataSetOperator;
12   end;

本文链接

FastReport微调

2011-11-03T02:07:00Z

在设计器中View->Options中调整Grid的大小默认为0.1mm，调成0.01后可以进行微调

本文链接

Delphi 字符串的引用计数与生命周期

2011-10-20T05:54:00Z

先来段代码

type
  MyString = AnsiString;
  PMyChar = PAnsiChar;

procedure TForm2.Button2Click(Sender: TObject);
var
  p: PMyChar;
  s, s2: MyString;
begin
  self.Caption := 'frmTest';  //7位的字符串
  p := GetCaption;
  s2 := p;   //这是时候s2 为frmTes
  ShowMessage(s2); //*****显示出来为frmTes
end;

function TForm2.GetCaption: PMyChar;
var
  s1, s2: MyString;
begin
  s2 := MyString(self.Caption);
  Result := PMyChar(MyString(s2));
end;

研究说明(代表个人意见)(XE下面测试)

function TForm2.GetCaption: PMyChar;
var
  s1: MyString;
begin
  s1 := MyString(Self.Caption);    //self.Caption源码得知，是获取了一块临时的空间(A1)
  //A1(integer(s1))

  i:= StringRefCount(s1);  //i=1

  Result := PMyChar(MyString(s1));  //Result指针指向的为(A1)的空间
  //Integer(@Result^) = A1(integer(s1))  是指向同一块空间

  i:= StringRefCount(s1);  //i=1
end;
//函数返回后s1因为是局部变量 s1的引用计数为0，integer(s1)的空间被标志为可以覆盖
//返回的为指针，不增加s1的引用计数

procedure TForm2.Button2Click(Sender: TObject);
var
  p: PMyChar;
  s, s2: MyString;
begin
  self.Caption := 'frmTest';
  p := GetCaption; //实际上p指向的那块地址被标注为可以覆盖，随时都有可能被覆盖,是很危险的
  //Integer(@p^) = GetCaption内部给s1分配的那块空间地址

s2 := p; //导致丢掉了字符..
//因为p指向的内存是可以被覆盖的,s2分配的地址可能和p指向的地址是一样的,导致丢掉了字符..
//Integer(s2) 可能= Integer(@p^) 测试是发现都一样

//下面操作(SetLength)同样也会一样结果，s2占用的和p占用的同样大小(或者小)。
//这样导致了s2分配的空间可能和p内存一样
//如果7改成较大的数就正常
// SetLength(s2, 7);
// StrCopy(PMyChar(s2), p);

ShowMessage(s2); //错误
end;

解决方案(1)

将s1定义为内成员变量,这样当GetCaption执行完后那块空间不会被标准为可读写

function TForm2.GetCaption2: PMyChar;
begin
  FMyCaption := MyString(Self.Caption);    //self.Caption源码得知，是获取了一块临时的空间(A1)
  //A1(integer(FMyCaption))

  i:= StringRefCount(FMyCaption);  //i=1

  Result := PMyChar(MyString(FMyCaption));  //Result指针指向的为(A1)的空间
  //Integer(@Result^) = A1(integer(FMyCaption))  是指向同一块空间

  i:= StringRefCount(FMyCaption);  //i=1
end;
//执行完后FMyCaption不是临时变量，指向的地址不可以被覆盖

procedure TForm2.btnGetCaption2Click(Sender: TObject);
var
  p: PMyChar;
  s, s2: MyString;
begin
  self.Caption := 'frmTest';
p := GetCaption2; //实际上p指向的那块地址和FMyCaption的地址是一样的
//Integer(@p^) = GetCaption2内部给FMyCaption分配的那块空间地址是一样

  s2 := p;
  //因为p指向的内存是不可以被覆盖的,s2分配的地址不可可能和p指向的地址是一样的,这样做是安全的
  //Integer(s2) <> Integer(@p^)

  i:= StringRefCount(s2);  //i=1  新的内存

  ShowMessage(s2);  //正确
end;

***

局部变量

function TForm2.GetCaption2: PMyChar;
var
s1: MyString;
begin

s1 := 'frmTest'
i:= StringRefCount(s1); //i=-1 常量地址指向空间不可被覆盖

//UniqueString(s1);
//i:= StringRefCount(s1); //i=1 s1又变成临时的，函数返回后s1指向的地址不再安全

Result=PMyChar(s1)
end;

本文链接

WideString和AnsiString

2011-10-19T07:31:00Z

var
ws: WideString;
s: AnsiString;
pw: PWideChar;
p: PAnsiChar;
begin
ws := 'ab中cd';
pw := PWideChar(ws);
s := ws;
//p:=PAnsiChar(s); 正确
//p:=PAnsiChar(String(pw));

//不正确
p := PAnsiChar(pw); //这样转换，inc(p)后显示的为00对应的为空

inc(p, 1); //
ShowMessage(p^);

双字节

a:6100

单字节

a:61

本文链接

The Delphi Container Library (DCLX) 几处BUG

2011-10-08T00:26:00Z

function TStrIntfHashMap.Remove(const Key: string): IInterface;
var
  Bucket: PStrIntfBucket;
  I: Integer;
{$IFDEF THREADSAFE}
  CS: IInterface;
{$ENDIF}
begin
{$IFDEF THREADSAFE}
  CS := EnterCriticalSection;
{$ENDIF}
  Result := nil;
  if Key = '' then
    Exit;
  Bucket := @(FBuckets[FHashFunction(HashString(Key))]);
  for I := 0 to Bucket.Count - 1 do
    if Bucket.Entries[I].Key = Key then
    begin

     //在Remove的时候仅仅只是返回了值，没有把Bucket.Entries[i]中的Value值进行置空。

     Result := Bucket.Entries[I].Value;

     //add by mofen
     Bucket.Entries[I].Value := nil;

      System.Move(Bucket.Entries[I + 1], Bucket.Entries[I],
       (Bucket.Count - I) * SizeOf(TStrStrEntry));
      Dec(Bucket.Count);
      Exit;
    end;
end;

我看了所有的Remove针对对象和接口的释放都貌似有些问题。

本文链接

Delphi的接口委托示例 (转)

2011-09-30T07:32:00Z

//转自http://www.cnblogs.com/MurphyAefe/articles/1741825.html

{
说明：该事例实现的效果，在单个应用或代码量小的项目中，可以完全不用接口委托来完成。
之所以采用委托接口，主要是应用到：已经实现的接口模块中，在不改变原有代码的情况下，
需要对其进行扩展；原始模块只需要开放部分功能，但又不能暴露实现细节的场合；
}

unit TestUnit;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

const
TestMsgGUID: TGUID = '{4BE80D5E-D94B-42BE-9114-077DC2708451}';

type
//原始接口中新增需要暴露给其它模块的接口定义，公用部分
ITestMsg = interface
['{4BE80D5E-D94B-42BE-9114-077DC2708451}']
procedure ShowTestMsg;
end;

//---------------------------------服务模块
//基类对象，只需要开放ShowTestMsg方法给外部，所以做为按口的实现基类
TBaseTestMsg = class(TInterfacedObject, ITestMsg)
public
//.... 模块已存在的老代码....

//新开放的接口代码方法
procedure ShowTestMsg; virtual; //申明成虚拟方法，以便继承类可以重载
end;

//---------------------------------接口委托对象定义
TTestMsgClass = class(TInterfacedObject, ITestMsg)
private
FTestMsg: ITestMsg;
public
property Service: ITestMsg read FTestMsg implements ITestMsg;

constructor Create(AClass: TClass);
constructor CreateEx(AClass: TClass); //另一种用法, 不采用TBaseTestMsg做为基类创建委托实例
destructor Destroy; override;
end;

//----------------------------------外部引用的业务模块
//完成具体业务的委托实例
TETestMsg = class(TInterfacedObject, ITestMsg)
public
procedure ShowTestMsg;
end;

//完成具体业务的委托实例
TCTestMsg = class(TInterfacedObject, ITestMsg)
public
procedure ShowTestMsg;
end;

TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
private
    { Private declarations }
public
    { Public declarations }
    procedure DoTest(AClass: TClass; ACreateEx: Boolean = False);     //测试方法
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TBaseTestMsg }

procedure TBaseTestMsg.ShowTestMsg;
begin
end;

{ TTestMsgClass }

constructor TTestMsgClass.Create(AClass: TClass);
var
vObj: TBaseTestMsg;
begin
vObj := TBaseTestMsg(AClass.NewInstance);
FTestMsg := vObj.Create;
end;

constructor TTestMsgClass.CreateEx(AClass: TClass);
begin
//该方法不采用TBaseTestMsg做为基类创建委托实例，更通用更灵活
(AClass.NewInstance.Create).GetInterface(TestMsgGUID, FTestMsg);
end;

destructor TTestMsgClass.Destroy;
begin
FTestMsg := nil;
inherited;
end;

{ TETestMsg }

procedure TETestMsg.ShowTestMsg;
begin
ShowMessage('TETestMsg Msg:' + 'OK');
end;

{ TCTestMsg }

procedure TCTestMsg.ShowTestMsg;
begin
ShowMessage('TCTestMsg 消息:' + '好的');
end;

//--------------------以下为测试代码--------------------------------

procedure TForm1.DoTest(AClass: TClass; ACreateEx: Boolean);
var
vClass: TTestMsgClass;
vTest: ITestMsg;
begin
if ACreateEx then
vClass := TTestMsgClass.CreateEx(AClass)
else
vClass := TTestMsgClass.Create(AClass);

try
    vTest := vClass;
    vTest.ShowTestMsg;
finally
    vTest := nil;
    FreeAndNil(vClass);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
DoTest(TETestMsg);
DoTest(TCTestMsg);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
DoTest(TETestMsg, True);
DoTest(TCTestMsg, True);
end;

end.

本文链接

设置数据库快照功能

2011-09-05T12:30:00Z

ALTER DATABASE CXFX_DATA
SET ALLOW_SNAPSHOT_ISOLATION ON

ALTER DATABASE CXFX_DATA
SET READ_COMMITTED_SNAPSHOT ON

//原来帮助里面写了，执行该语句时不能有其他东西连接数据库，难怪前几次执行了N久都没有反应,帮助没看仔细

本文链接

找出表的记录数

2011-09-01T03:38:00Z

自己写的

declare @count int
DECLARE @SQLString nvarchar(500)
        ,@TableName varchar(100)
SELECT top 1 @TableName = name from sysobjects where xtype='u'
SELECT @SQLString = 'select @innercount=count(1) from ' + @TableName

EXECUTE sp_executesql
   @SQLString
   ,N'@innercount int  OUTPUT'
   ,@innercount=@count OUTPUT
select @TableName + '记录数:' + CAST(@count as varchar(20))

网上的:

declare @name varchar(200)
declare @i int
declare @result table (name varchar(100))
declare @s nvarchar(100)
declare A cursor for (SELECT name FROM sysobjects where type='U')  OPEN A
fetch next from A into @name
WHILE @@FETCH_STATUS=0
begin
set @s='select top 10 @i=COUNT(1) from '+@name+''
exec sp_executesql @s,N'@i int output',@i
output
if @i>0
insert into @result select @name
fetch next from A into @name
end
close A
deallocate A
select * from @result

本文链接

cxgrid多选获取记录。不需要设置KeyFieldName

2011-08-23T01:23:00Z

procedure CopyGridRecordToJsn(pvDataSet: TcxGridDBTableView; pvValueJsn:
    ISuperObject);
var
  i, j: Integer;
  lvField: TcxGridDBColumn;
  lvItem: ISuperObject;
begin
  with pvDataSet, DataController do
  begin
    for i := 0 to Controller.SelectedRecordCount - 1 do
    begin
      lvItem := SO();
      try
        for j := 0 to pvDataSet.ColumnCount - 1 do
        begin
          lvField := pvDataSet.Columns[j];
          if lvField.DataBinding.ValueType <> 'Object' then
          begin
            lvItem.S[LowerCase(lvField.DataBinding.FieldName)] :=
                  VarToStrDef(GetValue(Controller.SelectedRecords[i].RecordIndex, j), '');
          end;
        end;
        pvValueJsn.O['select.value'] := lvItem;
        pvValueJsn.O['select.values[]'] := lvItem;
      finally
        lvItem := nil;
      end;
    end;
  end;
end;

本文链接